tsteele2000
MIS
I'm coding a macro that is attached to a button. The macro should basically take a range of values from a specified sheet in the workbook (always the same so it's hardcoded) and export as a comma delimited text file to a new file.
I copied the code from another website and edited it and when I run it, I'm getting the above mentioned error with the first line of the macro highlighted. Am I overlooking something obvious? Please advise, it's been a long time since I'm used VBA. Here is the code (sorry it's kind of long):
Sub ExportAsDelimited(SourceWB As String, SourceWS As String, SourceAddress As String, _
TargetFile As String, SepChar As String, SaveValues As Boolean, ExportLocalFormulas As Boolean, AppendToFile As Boolean)
ExportAsDelimited ThisWorkbook.Name, "ExportSheet", "A1:K136", "C:\temp\MortgagebotImportFile.txt", ",", True, True, False
' Exports the data in Workbooks(SourceWB).Worksheets(SourceWS).Range(SourceAddress) to
' the textfile TargetFile in CSV format, uses SepChar as column delimiter
' Example: ExportRangeAsDelimitedText ThisWorkbook.Name, "ExportSheet", "A3:E23", "C:\FolderName\DelimitedText.txt", ";", True, True, False
Dim SourceRange As Range, SC As String * 1
Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long
Dim fn As Integer, LineString As String, tLine As String
' validate the input data if necessary
Workbooks(SourceWB).Activate
Worksheets(SourceWS).Activate
If Application.WorksheetFunction.CountA(Range(SourceAddress)) = 0 Then Exit Sub
If Not AppendToFile Then
If Dir(TargetFile) <> "" Then
On Error Resume Next
Kill TargetFile
On Error GoTo 0
If Dir(TargetFile) <> "" Then
MsgBox TargetFile & " already exists, rename, move or delete the file before you try again.", vbInformation, "Export range to textfile"
Exit Sub
End If
End If
End If
If UCase(SepChar) = "TAB" Or UCase(SepChar) = "T" Then
SC = Chr(9)
Else
SC = Left(SepChar, 1)
End If
' perform export
Set SourceRange = Range(SourceAddress)
On Error GoTo NotAbleToExport
fn = FreeFile
Open TargetFile For Append As #fn ' open textfile for new input
On Error GoTo 0
' determine the total number of rows to process
totr = 0
For A = 1 To SourceRange.Areas.Count
totr = totr + SourceRange.Areas(A).Rows.Count
Next A
' start writing the character-separated textfile
pror = 0
For A = 1 To SourceRange.Areas.Count
For r = 1 To SourceRange.Areas(A).Rows.Count
LineString = ""
For c = 1 To SourceRange.Areas(A).Columns.Count
tLine = ""
On Error Resume Next
If SaveValues Then
tLine = SourceRange.Areas(A).Cells(r, c).Value
Else
If ExportLocalFormulas Then
tLine = SourceRange.Areas(A).Cells(r, c).FormulaLocal
Else
tLine = SourceRange.Areas(A).Cells(r, c).Formula
End If
End If
On Error GoTo 0
LineString = LineString & tLine & SC
Next c
pror = pror + 1
If pror Mod 50 = 0 Then
Application.StatusBar = "Writing delimited textfile " & Format(pror / totr, "0 %"
& "..."
End If
If Len(LineString) > 1 Then LineString = Left(LineString, Len(LineString) - 1)
If LineString = "" Then
Print #fn,
Else
Print #fn, LineString
End If
Next r
Next A
Close #fn ' close the textfile
NotAbleToExport:
Set SourceRange = Nothing
Application.StatusBar = False
End Sub
I copied the code from another website and edited it and when I run it, I'm getting the above mentioned error with the first line of the macro highlighted. Am I overlooking something obvious? Please advise, it's been a long time since I'm used VBA. Here is the code (sorry it's kind of long):
Sub ExportAsDelimited(SourceWB As String, SourceWS As String, SourceAddress As String, _
TargetFile As String, SepChar As String, SaveValues As Boolean, ExportLocalFormulas As Boolean, AppendToFile As Boolean)
ExportAsDelimited ThisWorkbook.Name, "ExportSheet", "A1:K136", "C:\temp\MortgagebotImportFile.txt", ",", True, True, False
' Exports the data in Workbooks(SourceWB).Worksheets(SourceWS).Range(SourceAddress) to
' the textfile TargetFile in CSV format, uses SepChar as column delimiter
' Example: ExportRangeAsDelimitedText ThisWorkbook.Name, "ExportSheet", "A3:E23", "C:\FolderName\DelimitedText.txt", ";", True, True, False
Dim SourceRange As Range, SC As String * 1
Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long
Dim fn As Integer, LineString As String, tLine As String
' validate the input data if necessary
Workbooks(SourceWB).Activate
Worksheets(SourceWS).Activate
If Application.WorksheetFunction.CountA(Range(SourceAddress)) = 0 Then Exit Sub
If Not AppendToFile Then
If Dir(TargetFile) <> "" Then
On Error Resume Next
Kill TargetFile
On Error GoTo 0
If Dir(TargetFile) <> "" Then
MsgBox TargetFile & " already exists, rename, move or delete the file before you try again.", vbInformation, "Export range to textfile"
Exit Sub
End If
End If
End If
If UCase(SepChar) = "TAB" Or UCase(SepChar) = "T" Then
SC = Chr(9)
Else
SC = Left(SepChar, 1)
End If
' perform export
Set SourceRange = Range(SourceAddress)
On Error GoTo NotAbleToExport
fn = FreeFile
Open TargetFile For Append As #fn ' open textfile for new input
On Error GoTo 0
' determine the total number of rows to process
totr = 0
For A = 1 To SourceRange.Areas.Count
totr = totr + SourceRange.Areas(A).Rows.Count
Next A
' start writing the character-separated textfile
pror = 0
For A = 1 To SourceRange.Areas.Count
For r = 1 To SourceRange.Areas(A).Rows.Count
LineString = ""
For c = 1 To SourceRange.Areas(A).Columns.Count
tLine = ""
On Error Resume Next
If SaveValues Then
tLine = SourceRange.Areas(A).Cells(r, c).Value
Else
If ExportLocalFormulas Then
tLine = SourceRange.Areas(A).Cells(r, c).FormulaLocal
Else
tLine = SourceRange.Areas(A).Cells(r, c).Formula
End If
End If
On Error GoTo 0
LineString = LineString & tLine & SC
Next c
pror = pror + 1
If pror Mod 50 = 0 Then
Application.StatusBar = "Writing delimited textfile " & Format(pror / totr, "0 %"
End If
If Len(LineString) > 1 Then LineString = Left(LineString, Len(LineString) - 1)
If LineString = "" Then
Print #fn,
Else
Print #fn, LineString
End If
Next r
Next A
Close #fn ' close the textfile
NotAbleToExport:
Set SourceRange = Nothing
Application.StatusBar = False
End Sub