Last active
February 22, 2024 09:21
-
-
Save fabriceleal/7803969 to your computer and use it in GitHub Desktop.
Decent enough macro for exporting csvs from Excel.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
' http://support.microsoft.com/kb/291296/en-us | |
' http://superuser.com/questions/130592/how-do-you-force-excel-to-quote-all-columns-of-a-csv-file | |
' - change integer to long indexing | |
' http://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba | |
' - output utf8 content | |
Sub QuoteCommaExport() | |
' Dimension all variables. | |
Dim DestFile As String | |
Dim FileNum As Integer | |
Dim ColumnCount As Long | |
Dim RowCount As Long | |
Dim fsT As Object | |
Set fsT = CreateObject("ADODB.Stream") | |
fsT.Type = 2 'Specify stream type - we want To save text/string data. | |
fsT.Charset = "utf-8" 'Specify charset For the source text data. | |
fsT.Open 'Open the stream And write binary data To the object | |
' Prompt user for destination file name. | |
DestFile = InputBox("Enter the destination filename" _ | |
& Chr(10) & "(with complete path):", "Quote-Comma Exporter") | |
' Obtain next free file handle number. | |
' FileNum = FreeFile() | |
' Turn error checking off. | |
On Error Resume Next | |
' If an error occurs report it and end. | |
If Err <> 0 Then | |
MsgBox "Cannot open filename " & DestFile | |
End | |
End If | |
' Turn error checking on. | |
On Error GoTo 0 | |
' Loop for each row in selection. | |
For RowCount = 1 To Selection.Rows.Count | |
' Loop for each column in selection. | |
For ColumnCount = 1 To Selection.Columns.Count | |
' Write current cell's text to file with quotation marks. | |
fsT.WriteText """" & Replace(Selection.Cells(RowCount, ColumnCount).Text, """", """""") & """" | |
' Check if cell is in last column. | |
If ColumnCount = Selection.Columns.Count Then | |
' If so, then write a blank line. | |
fsT.WriteText vbNewLine | |
Else | |
' Otherwise, write a comma. | |
fsT.WriteText "," | |
End If | |
' Start next iteration of ColumnCount loop. | |
Next ColumnCount | |
' Start next iteration of RowCount loop. | |
Next RowCount | |
' Close destination file. | |
fsT.SaveToFile DestFile, 2 | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Ok... frustration time. This script worked great for the first few days. Now it errors out with 3004 write to file failed.
No environmental changes I know of. Cut and pasted copy of the original script from here and used it on the same bloody source file.
Still nuttin'.
Anyone have any idea what I may have done to break it?