Export Range to CSV to certain location on a HDD

[luzikedy]

Hi All,

Below is the code I found somewhere in this or another forum, unfortunately it was long time ago, so I cannot give any credit to the author.

I would like to ask you guys what to add to the code that the file always saves at the same location specified by me. For example "//MAC/HOME/DESKTOP/"
Have in mind that I also specify the name of the file in a cell strFileName = Sheets("DATA").Range("K2").Value & ".csv"
Now it saves on the last saved location.

Option Explicit


Const strDelimiter = ""
Const strDelimiterEscaped = strDelimiter & strDelimiter
Const strSeparator = ","
Const strRowEnd = vbCrLf
Const strCharset = "utf-8"


Function CsvFormatString(strRaw As String) As String


Dim boolNeedsDelimiting As Boolean


boolNeedsDelimiting = InStr(1, strRaw, strDelimiter) > 0 _
Or InStr(1, strRaw, Chr(10)) > 0 _
Or InStr(1, strRaw, strSeparator) > 0


CsvFormatString = strRaw


If boolNeedsDelimiting Then
CsvFormatString = strDelimiter & _
Replace(strRaw, strDelimiter, strDelimiterEscaped) & _
strDelimiter
End If


End Function


Function CsvFormatRow(rngRow As Range) As String


Dim arrCsvRow() As String
ReDim arrCsvRow(rngRow.Cells.Count - 1)
Dim rngCell As Range
Dim lngIndex As Long


lngIndex = 0


For Each rngCell In rngRow.Cells
arrCsvRow(lngIndex) = CsvFormatString(rngCell.Text)
lngIndex = lngIndex + 1
Next rngCell




CsvFormatRow = Join(arrCsvRow, ",") & strRowEnd


End Function


Sub CsvExportRange( _
rngRange As Range)


Dim strFileName As String


strFileName = Sheets("DATA").Range("K2").Value & ".csv"
Dim rngRow As Range
Dim objStream As Object


Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Charset = strCharset
objStream.Open


For Each rngRow In rngRange.Rows
objStream.WriteText CsvFormatRow(rngRow)
Next rngRow


objStream.SaveToFile strFileName, 2
objStream.Close


End Sub


Sub CsvExportSelection()




ActiveSheet.Range("Ah4:Ah51").Copy
Sheets("Export_Csv").Range("A2").PasteSpecial xlPasteValues
CsvExportRange Sheets("EXPORT_CSV").Range("A1:a100")


End Sub