I have been trying for a few days to crack this.
We have a Lotus Notes DB that will only accept and import of a file only if it is saved in this method
1) Opening a XLS in Open Office
2) Selecting all cells (always a single worksheet) and setting Default Formatting
3) Saving as TXT CSV
4) Then as part of the exporting process Saving as UTF-8, Field Delimiter = , text Delimiter = " AND Quote all TXT Cells
I have looked around at various pieces, and I cannot seem to be able to find exactly what I need. Would love some assistance
Here is what I have
<CODE>
<code>
Sub OTimport()
ThisWorkbook.ActiveSheet.Cells.ClearFormats
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("C:\Users\ADMIN\Desktop\Report work\OTIMPORT" & Format(Now(), "DD-MMM-YYYY hh mm AMPM"), "CSV File (*.csv), *.csv")
If fileName = "False" Then
End
End If
On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open
For r = 1 To 10
s = ""
C = 1
While Not IsEmpty(wkb.Cells(r, C).Value)
s = s & wkb.Cells(r, C).Value & ","
C = C + 1
Wend
BinaryStream.WriteText s, 1
Next r
BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close
MsgBox "CSV generated successfully"
eh:
End Sub
</CODE></code>
We have a Lotus Notes DB that will only accept and import of a file only if it is saved in this method
1) Opening a XLS in Open Office
2) Selecting all cells (always a single worksheet) and setting Default Formatting
3) Saving as TXT CSV
4) Then as part of the exporting process Saving as UTF-8, Field Delimiter = , text Delimiter = " AND Quote all TXT Cells
I have looked around at various pieces, and I cannot seem to be able to find exactly what I need. Would love some assistance
Here is what I have
<CODE>
<code>
Sub OTimport()
ThisWorkbook.ActiveSheet.Cells.ClearFormats
Set wkb = ActiveSheet
Dim fileName As String
Dim MaxCols As Integer
fileName = Application.GetSaveAsFilename("C:\Users\ADMIN\Desktop\Report work\OTIMPORT" & Format(Now(), "DD-MMM-YYYY hh mm AMPM"), "CSV File (*.csv), *.csv")
If fileName = "False" Then
End
End If
On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open
For r = 1 To 10
s = ""
C = 1
While Not IsEmpty(wkb.Cells(r, C).Value)
s = s & wkb.Cells(r, C).Value & ","
C = C + 1
Wend
BinaryStream.WriteText s, 1
Next r
BinaryStream.SaveToFile fileName, adSaveCreateOverWrite
BinaryStream.Close
MsgBox "CSV generated successfully"
eh:
End Sub
</CODE></code>
Last edited: