Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Error Message - subscript out of range, please help

Status
Not open for further replies.
Aug 19, 2003
7
US
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) <> &quot;&quot; Then
On Error Resume Next
Kill TargetFile
On Error GoTo 0
If Dir(TargetFile) <> &quot;&quot; Then
MsgBox TargetFile & &quot; already exists, rename, move or delete the file before you try again.&quot;, vbInformation, &quot;Export range to textfile&quot;
Exit Sub
End If
End If
End If
If UCase(SepChar) = &quot;TAB&quot; Or UCase(SepChar) = &quot;T&quot; 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 = &quot;&quot;
For c = 1 To SourceRange.Areas(A).Columns.Count
tLine = &quot;&quot;
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 = &quot;Writing delimited textfile &quot; & Format(pror / totr, &quot;0 %&quot;) & &quot;...&quot;
End If
If Len(LineString) > 1 Then LineString = Left(LineString, Len(LineString) - 1)
If LineString = &quot;&quot; Then
Print #fn,
Else
Print #fn, LineString
End If
Next r
Next A
Close #fn ' close the textfile
NotAbleToExport:
MsgBox (&quot;error&quot;)
Set SourceRange = Nothing
Application.StatusBar = False
End Sub


Any help is much appreciated.
 
It's empty. The variables I'm passing are not getting populated I guess, but I don't know why.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top