i have a excel file that grabs data from an odbc drive then compiles the data into a csv file. I want to update the script below to save the file to the users desktop (its fine if i have to modify the username code) with no prompts. I stole this script from someone else's example and can't figure out how to modify it to save to the desktop versus "save as". Please help so I can wrap up this project!
===================================
Sub ExportRangetoFile()
' -------------------------------------------------------------------------------------------------------------------
'
' General function: exports strings contained in a range (1 column wide, varying height) into a text file
'
' -------------------------------------------------------------------------------------------------------------------
Const ForAppending = 8
Const rStartCell = "macroSwitch_OutputTextBelow"
Const strFileNamePrefix = "Valor Teamworx Export "
Dim fs, f
Dim saveFile As String
Dim WorkRng As Range
Dim iHeightOfDataRange
On Error Resume Next
' figure out how many rows to select and export:
' start at range "macroSwitch_OutputTextBelow"
' look down to last filled in row to count number of rows with actual check data
' then use that height as height for range to be exported
iHeightOfDataRange = Range(rStartCell).End(xlDown).Row - Range(rStartCell).Row
Set WorkRng = Application.Selection
Set WorkRng = Range(rStartCell).Offset(1, 0).Resize(iHeightOfDataRange, 1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' create file to export to
Set fs = CreateObject("Scripting.FileSystemObject")
saveFile = Application.GetSaveAsFilename(InitialFileName:=strFileNamePrefix & Format(Now(), "yyyy-mm-dd"), _
filefilter:="Comma Separated Text (*.CSV), *.CSV")
Set f = fs.createTextFile(saveFile, ForAppending, TristateFalse)
' and write export range line by line
For Each Row In WorkRng.Rows
f.writeline Row
Next Row
f.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
==========================================
===================================
Sub ExportRangetoFile()
' -------------------------------------------------------------------------------------------------------------------
'
' General function: exports strings contained in a range (1 column wide, varying height) into a text file
'
' -------------------------------------------------------------------------------------------------------------------
Const ForAppending = 8
Const rStartCell = "macroSwitch_OutputTextBelow"
Const strFileNamePrefix = "Valor Teamworx Export "
Dim fs, f
Dim saveFile As String
Dim WorkRng As Range
Dim iHeightOfDataRange
On Error Resume Next
' figure out how many rows to select and export:
' start at range "macroSwitch_OutputTextBelow"
' look down to last filled in row to count number of rows with actual check data
' then use that height as height for range to be exported
iHeightOfDataRange = Range(rStartCell).End(xlDown).Row - Range(rStartCell).Row
Set WorkRng = Application.Selection
Set WorkRng = Range(rStartCell).Offset(1, 0).Resize(iHeightOfDataRange, 1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' create file to export to
Set fs = CreateObject("Scripting.FileSystemObject")
saveFile = Application.GetSaveAsFilename(InitialFileName:=strFileNamePrefix & Format(Now(), "yyyy-mm-dd"), _
filefilter:="Comma Separated Text (*.CSV), *.CSV")
Set f = fs.createTextFile(saveFile, ForAppending, TristateFalse)
' and write export range line by line
For Each Row In WorkRng.Rows
f.writeline Row
Next Row
f.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
==========================================