tsteele2000
MIS
I am getting one error message after another with this!
This click event macro should select the specified range of data on the worksheet and export it into a new comma delimited file. I am getting "Subscript Out of Range" on the line "Workbooks(SourceWB).Activate" when I run the macro. If I comment that line out, I get the same error on the next line.
I get that there is some sort of problem with the way I'm referencing these objects, but I don't know what it is!
Here is the code:
Sub PassArgs(SourceWB As String, SourceWS As String, SourceAddress As String, _
TargetFile As String, SepChar As String, SaveValues As Boolean, ExportLocalFormulas As Boolean, AppendToFile As Boolean)
End Sub
'End Sub
Private Sub cmdExport_Click()
PassArgs 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 SourceWB As String,
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:
MsgBox ("error"
Set SourceRange = Nothing
Application.StatusBar = False
End Sub
Any help is much appreciated.
This click event macro should select the specified range of data on the worksheet and export it into a new comma delimited file. I am getting "Subscript Out of Range" on the line "Workbooks(SourceWB).Activate" when I run the macro. If I comment that line out, I get the same error on the next line.
I get that there is some sort of problem with the way I'm referencing these objects, but I don't know what it is!
Here is the code:
Sub PassArgs(SourceWB As String, SourceWS As String, SourceAddress As String, _
TargetFile As String, SepChar As String, SaveValues As Boolean, ExportLocalFormulas As Boolean, AppendToFile As Boolean)
End Sub
'End Sub
Private Sub cmdExport_Click()
PassArgs 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 SourceWB As String,
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:
MsgBox ("error"
Set SourceRange = Nothing
Application.StatusBar = False
End Sub
Any help is much appreciated.