Put textfile on desktop

[av8tordude]

the code below creates a text file of data in my workbook. Currently the file is be created My Documents folder. Can someone assist me in editing this code that insert the file on my desktop. Thank you.

[Bob Phillips]

Code?

[av8tordude]

Oops...Sorry

Sub CreateTxtFile()
Dim fPath As String, fName As String
Dim aWb As Workbook, wb As Workbook, rng As Range, r As Long
Set aWb = ActiveWorkbook
fPath = aWb.Path
If Right$(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = aWb.Name
fName = fPath & Left$(fName, InStrRev(fName, ".") - 1)
With Application
    .DisplayAlerts = 0
    .ScreenUpdating = 0
    .EnableEvents = 0
End With
On Error GoTo Xit
With aWb.Sheets("Calculator")
    r = Application.Max(11, .Range("B" & 250).End(xlUp).Row)
    If r = 9 Then Exit Sub
    Set rng = .Range("B11:L9" & r)
End With
Set wb = Workbooks.add
rng.Copy wb.Sheets(1).Range("a1")
wb.SaveAs FileName:="Expense Report.csv", FileFormat:=xlCSV
wb.Close False
Set wb = Nothing
Set rng = Nothing
Set aWb = Nothing
Xit:
With Application
    .DisplayAlerts = 1
    .ScreenUpdating = 1
    .EnableEvents = 1
End With
End Sub

[GTO]

Greetings,

I believe that it is currently saving to My Documents simply because that is the current directory (current folder). You could simply use ChDir or:

Not tested, try in junk copy of your wb...

    'REPLACE:
    'wb.SaveAs FileName:="Expense Report.csv", FileFormat:=xlCSV
    'WITH
    If Len(Dir$("C:\Documents and Settings\" & Environ("USERNAME") & "\Desktop", 16)) Then
        wb.SaveAs Filename:="C:\Documents and Settings\" & _
                             Environ("USERNAME") & _
                             "\Desktop\Expense Report.csv", _
                                FileFormat:=xlCSV
    Else
        wb.SaveAs Filename:="Expense Report.csv", FileFormat:=xlCSV
        MsgBox """Desktop"" not found.  File saved as: " & wb.FullName, _
               vbInformation, vbNullString
    End If

The above tests for a good return on the the environmental variable (which I have never ran into problems with, just for safety), and saves to desktop.

Hope that helps,

Mark

[Bob Phillips]

[vba]

Sub CreateTxtFile()
Dim fPath As String, fName As String
Dim fDesktop As String
Dim aWb As Workbook, wb As Workbook, rng As Range, r As Long
Set aWb = ActiveWorkbook
fPath = aWb.Path
fDesktop = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & Application.PathSeparator
If Right$(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = aWb.Name
fName = fPath & Left$(fName, InStrRev(fName, ".") - 1)
With Application
.DisplayAlerts = 0
.ScreenUpdating = 0
.EnableEvents = 0
End With
On Error GoTo Xit
With aWb.Sheets("Calculator")
r = Application.Max(11, .Range("B" & 250).End(xlUp).Row)
If r = 9 Then Exit Sub
Set rng = .Range("B11:L9" & r)
End With
Set wb = Workbooks.Add
rng.Copy wb.Sheets(1).Range("a1")
wb.SaveAs Filename:=fDesktop & "Expense Report.csv", FileFormat:=xlCSV
wb.Close False
Set wb = Nothing
Set rng = Nothing
Set aWb = Nothing
Xit:
With Application
.DisplayAlerts = 1
.ScreenUpdating = 1
.EnableEvents = 1
End With
End Sub
[/vba]