开发者

Excel VBA - Code used to work, can't find the issue now

开发者 https://www.devze.com 2023-04-12 19:44 出处:网络
I was using this code and it was working just fine before, but now for some reason I\'m getting an error that just says \"400\" and I didn\'t think I changed anything.

I was using this code and it was working just fine before, but now for some reason I'm getting an error that just says "400" and I didn't think I changed anything.

Sub getdata()

Dim xcell As Range
Dim ycell As Range
Dim sheetname As String
Dim wblist() As String
Dim i As Integer
Dim wbname As String
Dim j As Integer

i = 0
j开发者_运维问答 = 0

FolderName = "C:\Documents and Settings\shahzad.khan\Desktop\CRs\LOG"
wbname = Dir(FolderName & "\" & "*.xls")

Application.ScreenUpdating = False

Do While wbname <> ""

i = i + 1
ReDim Preserve wblist(1 To i)
wblist(i) = wbname
wbname = Dir


Set ycell = Range(Cells(i + 3, 2), Cells(i + 2, 28))
Set xcell = Range(Cells(2, 3), Cells(2, 28))
sheetname = "loging form"

ycell.Formula = "=" & "'" & FolderName & "\[" & wblist(i) & "]" _
& sheetname & "'!" & xcell.Address

Loop

Do While j < 100
Cells(j + 3, 1).Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[6],4)"

Cells(3 + j, 1) = Val(Cells(3 + j, 1))
Cells(3 + j, 2).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[CR Status.xlsx]Sheet1'!R3C1:R189C3,3,FALSE)"

If Cells(3 + j, 1).Value = 0 Then
Cells(3 + j, 1).Value = ""
Cells(3 + j, 2).Value = ""
End If

j = j + 1

Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True

Cells(1, 1).Select

End Sub

I know the code isn't very efficient right now but it was working. It seems to be pasting most of the information I want but for some reason it's not capturing the first and last column from the excel files that I'm trying to pull from, and the second loop isn't even start. Also, its not accessing every file in the folder anymore, it seems to be stopping around 4 files before the end of the directory. Any help would be appreciated, thank you!


Error 400 corresponds to a Application-Defined or Object-Defined error. Which means it doesn't like or understand your reference to something usually.

Browsing through your code the only place that pops out is your

   Do While j < 100
   Cells(j + 3, 1).Select
   ActiveCell.FormulaR1C1 = "=LEFT(RC[6],4)"

Unless I missed it I dont see where you referenced what worksheet you're wanting it to loop through.

By the way you really should never have to "Select" a cell. It's slow and inefficient. Same with Worksheets. You can just do something similar to..

   Do While j < 100
   'First way
   Sheet1.Cells(J+3,1).FormulaR1C1 = "=Left(RC[6],4)"
   'Second way
   Worksheets("Sheet1").Cells(J+3,1).FormulaR1C1 = "=Left(RC[6],4)"

Try to make sure all your references are explicitly set (Use f8 and loop through the code and watch the "Locals" window) and let me know if you have any problems, we'll narrow it down from there.

EDIT: Lets back this all the way up and tackle it from another point of view. What you need to do is go to Tools -> References -> and scroll down to Microsoft Scripting Runtime and click it and hit ok. Then use the following code.

Sub Main()
Dim FSO As FileSystemObject
Dim File As File
Dim Folder As Folder
Dim Files As Files
Dim WkBook As Workbook
Dim FileInfo As Variant

Set FSO = New FileSystemObject
Set Folder = FSO.GetFolder("C:\Documents and Settings\shahzad.khan\Desktop\CRs\LOG")
Set Files = Folder.Files

For Each File In Files

    If Right(File.Name, 3) = "xls" Then

    Set WkBook = Workbooks.Open(File)
    FileInfo = WkBook.Worksheets("Sheet1").Range("A2:J400").Value

    'Do Work With Array Here

    WkBook.Close
    End If

Next

Set Files = Nothing
Set Folder = Nothing
Set FSO = Nothing


End Sub

Now, That code will work regardless of how many files you add or subtract. When you're done with working with the array and want to put the info into another excel sheet you can just flip the code around. Like...

MyWorkbook.Worksheet("Sheet1").Range("A2:J400") = FileInfo

I know that doesn't answer the original question, but Error 400 usually ALWAYS means that something changed somewhere and now it can't find it. Rather than go looking for it, it's usually easier just to code in some protection.

0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号