PDA

View Full Version : Put textfile on desktop



av8tordude
05-15-2010, 06:58 AM
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
05-15-2010, 07:08 AM
Code?

av8tordude
05-15-2010, 07:14 AM
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
05-15-2010, 09:40 AM
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
05-15-2010, 11:25 AM
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