Modifying code to save data

[Constantly Amazed]

Hi

Further to an earlier posting I have found some code on Chip Pearsons site
(thank you Chip) which allows me to save some data from Excel into a CSV text
file. However, I would like to give the user the opportunity to save the
text file under a name of their choosing and the destination folder (best if
this could be done by using the standard Windows browse function) Could
anyone please tell me how to amend the code below to interupt and allow the
user to select where the text.txt file is stored.

Sub DoTheExport()
ExportToTextFile FName:="C:\Test.txt", Sep:=";", _
SelectionOnly:=True, AppendData:=False

End Sub

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub

Thanks for any help.

 

[Bob Phillips]

Sub DoTheExport()
Dim mpFilename As Variant

mpFilename = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.txt), *.txt")
If mpFilename <> False Then

ExportToTextFile FName:=CStr(mpFilename), _
Sep:=";", _
SelectionOnly:=True, _
AppendData:=False
End If

End Sub

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile

If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If

If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Text
End If
WholeLine = WholeLine & CellValue & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Constantly Amazed]

Hi Bob

Thank you for the response but I am not sure if this is working fully. When
I now run the macro the Save As window comes up and I can select, say My
Documents/Temp. I enter a file name such as CSV Export Test and the file
type is shown as Text. However, when I use the Explore function I cannot see
the file. I have also searched all the C drive and cannot find the file.

Any ideas?

Thanks

 

[Constantly Amazed]

Sorry Bob

Your modification worked fine, thank you very much. My other post was in
error and it did not work because of a typo I had managed to introduce.

Once again I really appreciate how you guys help out us without the
experience.

Regards

G

 

[Bob Phillips]

Great, I did take a look and couldn't find a problem.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)