This is a lazy macro to save a single tab in an excel sheet as a csv file.
Last active
October 10, 2019 11:23
-
-
Save f-steff/cb53a996dbcfa1d8272db9811429f635 to your computer and use it in GitHub Desktop.
Excel macro to save proper csv files regardless of system settings
This file contains hidden or 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
Private Sub save_CSV() | |
' Written by Flemming Steffensen, 1997 | |
' The CSV ("Comma Separated Values") File Format: (Simple as it is, Microsoft can not follow the rules!) | |
' * Each record is one line - Line separator may be LF (0x0A) or CRLF (0x0D0A), a line seperator may also be embedded in the data (making a record more than one line but still acceptable). | |
' * Fields are separated with commas. - Duh. | |
' * Leading and trailing whitespace is ignored - Unless the field is delimited with double-quotes in that case the whitespace is preserved. | |
' * Embedded commas - Field must be delimited with double-quotes. | |
' * Embedded double-quotes - Embedded double-quote characters must be doubled, and the field must be delimited with double-quotes. | |
' * Embedded line-breaks - Fields must be surounded by double-quotes. | |
' * Always Delimiting - Fields may always be delimited with double quotes, the delimiters will be parsed and discarded by the reading applications. | |
Dim rCell As Range | |
Dim rRow As Range | |
Dim sOut As String | |
sCSV_Name = ThisWorkbook.Name | |
sCSV_Name = Application.GetSaveAsFilename(InitialFileName:=sCSV_Name, FileFilter:="Text Files (*.csv), *.csv") | |
If sCSV_Name <> False Then | |
FileNumber = FreeFile | |
Open sCSV_Name For Output Shared As #FileNumber | |
For Each rRow In ActiveSheet.UsedRange.Rows | |
sOut = "" | |
For Each rCell In rRow.Cells | |
NewCellValue = "" | |
CellValue = rCell.Value | |
For a = 1 To Len(CellValue) | |
temp = Mid(CellValue, a, 1) | |
If temp = Chr(34) Then temp = Chr(34) & Chr(34) | |
NewCellValue = NewCellValue & temp | |
Next a | |
sOut = sOut & Chr(34) & NewCellValue & Chr(34) & "," | |
Next rCell | |
sOut = Left(sOut, Len(sOut) - 1) | |
Print #FileNumber, sOut | |
Next rRow | |
Close #FileNumber | |
End If | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment