Macro to Export Active Cells, Comma Sep to .txt file

S

Stryves

Hello, this is my first post on a very old subject.

There are 2 changes I'd like to make to this code.

1. I'd like it not to ask for a filename, and use the Worksheet name
instead.
2. This code save a Tab separated text file, I'd like to use Comma's
instead.

I tried changing vbTab to vbComma, but then I get an error on the line
"CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)".

Any assistance would be appreciated!

Sub OutputActiveSheetAsTabDelim()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim ColCount As Integer
Dim CurrCol As Integer
FName = Application.GetSaveAsFilename("", "Tab Delimited File
(*.txt),*.txt")
If FName <> False Then
ListSep = vbTab ''Chg to comma, etc for a different separator
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
ColCount = SrcRg.Columns.Count
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrCol = 0
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrCol = CurrCol + 1
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End If
End Sub
 
T

Tom Ogilvy

Sub OutputActiveSheetAsTabDelim()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim ColCount As Integer
Dim CurrCol As Integer
sPath = "C:\Myfolder\"
FName = sPath & Activesheet.Name & ".csv"
ListSep = ","
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
ColCount = SrcRg.Columns.Count
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrCol = 0
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrCol = CurrCol + 1
CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top