Problem with import Macro

[bthomas]

I tried to adapt this code into my own from another thread. http://www.mrexcel.com/forum/showthread.php?t=385669&highlight=import+file

BUT, I am getting an error when running it. On the "For i" line. And I know just enough VBA to be dangerous. Can someone help?

I have another code setup to run if a certain cell equals "October" then it calls ImportData. Then this code is supposed to pull all files out of My Documents/TechConnect/October08 and place the data into sheet 1.

Sub ImportData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim MyDir As String, LR As Long, LR2 As Long, i As Long
Dim FType As String
Dim FName As String
Dim wbkArray() As String
'get a list of WBs in folder
z = 0
    FType = "C:\My Documents\TechConnect\October08*.xls"
    FName = Dir(FType)
    Do Until FName = ""
    z = z + 1
    ReDim Preserve wbkArray(1 To z)
    wbkArray(z) = FName
    FName = Dir
    Loop
MyDir = "C:\My Documents\TechConnect\October08"
LR = 4
For i = LBound(wbkArray) To UBound(wbkArray)
With Workbooks.Open(MyDir & wbkArray(i))
With Sheets("ESAFE Site Listing")
LR2 = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
.Range("A8:A" & LR2).Copy ThisWorkbook.Sheets("1").Range("A" & LR)
.Range("B8:B" & LR2).Copy ThisWorkbook.Sheets("1").Range("B" & LR)
.Range("C8:C" & LR2).Copy ThisWorkbook.Sheets("1").Range("C" & LR)
.Range("D8:D" & LR2).Copy ThisWorkbook.Sheets("1").Range("D" & LR)
.Range("E8:E" & LR2).Copy ThisWorkbook.Sheets("1").Range("E" & LR)
.Range("F8:F" & LR2).Copy ThisWorkbook.Sheets("1").Range("F" & LR)
.Range("G8:G" & LR2).Copy ThisWorkbook.Sheets("1").Range("G" & LR)
.Range("H8:H" & LR2).Copy ThisWorkbook.Sheets("1").Range("H" & LR)
.Range("I8:I" & LR2).Copy ThisWorkbook.Sheets("1").Range("I" & LR)
.Range("J8:J" & LR2).Copy ThisWorkbook.Sheets("1").Range("J" & LR)
.Range("K8:K" & LR2).Copy ThisWorkbook.Sheets("1").Range("K" & LR)
.Range("L8:L" & LR2).Copy ThisWorkbook.Sheets("1").Range("L" & LR)
.Range("M8:M" & LR2).Copy ThisWorkbook.Sheets("1").Range("M" & LR)
.Range("N8:N" & LR2).Copy ThisWorkbook.Sheets("1").Range("N" & LR)
.Range("O8:O" & LR2).Copy ThisWorkbook.Sheets("1").Range("O" & LR)
.Range("P8:P" & LR2).Copy ThisWorkbook.Sheets("1").Range("P" & LR)
.Range("Q8:Q" & LR2).Copy ThisWorkbook.Sheets("1").Range("Q" & LR)
.Range("R8:R" & LR2).Copy ThisWorkbook.Sheets("1").Range("R" & LR)
.Range("S8:S" & LR2).Copy ThisWorkbook.Sheets("1").Range("S" & LR)
.Range("T8:T" & LR2).Copy ThisWorkbook.Sheets("1").Range("T" & LR)
.Range("U8:U" & LR2).Copy ThisWorkbook.Sheets("1").Range("U" & LR)
.Range("V8:V" & LR2).Copy ThisWorkbook.Sheets("1").Range("V" & LR)
.Range("W8:W" & LR2).Copy ThisWorkbook.Sheets("1").Range("W" & LR)
.Range("X8:X" & LR2).Copy ThisWorkbook.Sheets("1").Range("X" & LR)
.Range("Y8:Y" & LR2).Copy ThisWorkbook.Sheets("1").Range("Y" & LR)
.Range("Z8:Z" & LR2).Copy ThisWorkbook.Sheets("1").Range("Z" & LR)
.Range("AA8:AA" & LR2).Copy ThisWorkbook.Sheets("1").Range("AA" & LR)
.Range("AB8:AB" & LR2).Copy ThisWorkbook.Sheets("1").Range("AB" & LR)
.Range("AC8:AC" & LR2).Copy ThisWorkbook.Sheets("1").Range("AC" & LR)
.Range("AD8:AD" & LR2).Copy ThisWorkbook.Sheets("1").Range("AD" & LR)
.Range("AE8:AE" & LR2).Copy ThisWorkbook.Sheets("1").Range("AE" & LR)
.Range("AF8:AF" & LR2).Copy ThisWorkbook.Sheets("1").Range("AF" & LR)
.Range("AG8:AG" & LR2).Copy ThisWorkbook.Sheets("1").Range("AG" & LR)
.Range("AH8:AH" & LR2).Copy ThisWorkbook.Sheets("1").Range("AH" & LR)
.Range("AI8:AI" & LR2).Copy ThisWorkbook.Sheets("1").Range("AI" & LR)
.Range("AJ8:AJ" & LR2).Copy ThisWorkbook.Sheets("1").Range("AJ" & LR)
.Range("AK8:AK" & LR2).Copy ThisWorkbook.Sheets("1").Range("AK" & LR)
.Range("AL8:AL" & LR2).Copy ThisWorkbook.Sheets("1").Range("AL" & LR)
.Range("AM8:AM" & LR2).Copy ThisWorkbook.Sheets("1").Range("AM" & LR)
.Range("AN8:AN" & LR2).Copy ThisWorkbook.Sheets("1").Range("AN" & LR)
.Range("AO8:AO" & LR2).Copy ThisWorkbook.Sheets("1").Range("AO" & LR)
.Range("AP8:AP" & LR2).Copy ThisWorkbook.Sheets("1").Range("AP" & LR)
.Range("AQ8:AQ" & LR2).Copy ThisWorkbook.Sheets("1").Range("AQ" & LR)
.Range("AR8:AR" & LR2).Copy ThisWorkbook.Sheets("1").Range("AR" & LR)
.Range("AS8:AS" & LR2).Copy ThisWorkbook.Sheets("1").Range("AS" & LR)
.Range("AT8:AT" & LR2).Copy ThisWorkbook.Sheets("1").Range("AT" & LR)
.Range("AU8:AU" & LR2).Copy ThisWorkbook.Sheets("1").Range("AU" & LR)
.Range("AV8:AV" & LR2).Copy ThisWorkbook.Sheets("1").Range("AV" & LR)
.Range("AW8:AW" & LR2).Copy ThisWorkbook.Sheets("1").Range("AW" & LR)
.Range("AX8:AX" & LR2).Copy ThisWorkbook.Sheets("1").Range("AX" & LR)
.Range("AY8:AY" & LR2).Copy ThisWorkbook.Sheets("1").Range("AY" & LR)
.Range("AZ8:AZ" & LR2).Copy ThisWorkbook.Sheets("1").Range("AZ" & LR)
.Range("BA8:BA" & LR2).Copy ThisWorkbook.Sheets("1").Range("BA" & LR)
.Range("BB8:BB" & LR2).Copy ThisWorkbook.Sheets("1").Range("BB" & LR)
.Range("BC8:BC" & LR2).Copy ThisWorkbook.Sheets("1").Range("BC" & LR)
.Range("BD8:BD" & LR2).Copy ThisWorkbook.Sheets("1").Range("BD" & LR)
End With
.Close False
End With
LR = ThisWorkbook.Sheets("1").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next i
MsgBox "The number of lines moved is " & LR - 4
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[millhouse123]

Do the first do loop you wrote seem to loop the right number of times if you press F8 and run it in break mode.

Do you need to add somthing after the Dir at the bottom of that loop?

 

[bthomas]

I'm not sure. Is it missing something? This part of the code I do not understand. It is a direct copy from the link. I can only ready basic VBA. I have tried to make sense of this one, but I can't seem to get it.

 

[Von Pookie]

BUT, I am getting an error when running it. On the "For i" line. And I know just enough VBA to be dangerous. Can someone help?

What is the error message being displayed?

 

[bthomas]

The error I am receiving.

Highlights
"For i = LBound(wbkArray) To UBound(wbkArray)"
in yellow

and says...
"Run-time error '9':
Subscript out of range"

 

[bthomas]

I think it is a problem with the wkbArray portion, because when I hover over the wbkArray(z) = FName line a flag pops up saying subscript out of range.

 

[Von Pookie]

Are you certain you have the correct filepath?

FType = "C:\My Documents\TechConnect\October08*.xls"

On my computer, the My Documents folder is under
C:\Documents and Settings\username\My Documents\

If the path is not correct to begin with, the wbkarray variable will not have a value and will return that error. If you step through the code with F8 you can see if it is going through the loop or not (ie, if it found any files matching that search string it will go into the loop).

 

[bthomas]

THANK YOU!!!! That fixed it, but now I have a problem with this being used on other computers. The username will be different in the path. Is there a way to get around that?

 

[Von Pookie]

Sure:

"C:\Documents and Settings\" & Environ("username") & "\My Documents\TechConnect\October08*.xls"

 

[bthomas]

Perfect! Thank you, thank you, thank you!