简体   繁体   中英

VBA ACCESS - Loop Excel workbooks

The following vba opens an excel workbook checks to see if its in read-only mode, if it is then waits till read/write is active then runs code. Simple

My Questions is that I have a lot of excel files eg C:\\TEST\\TEST.xlsb, C:\\TEST\\TEST2.xlsb ,C:\\TEST\\TEST3.xlsb ,C:\\TEST\\TEST4.xlsb etc

How do I get the VBA to run code through each workbook name

Save me time copy/pasting code several times for each workbook name.

Function test()

Dim xl As Object

Set xl = CreateObject("Excel.Application")

xl.Workbooks.Open ("C:\TEST\Test.xlsb")

Do Until xl.ActiveWorkbook.ReadOnly = False

MsgBox ("Workbook in use, waiting till read/write is active")
Call Pause(5)
xl.Quit
xl.Workbooks.Open ("C:\TEST\Test.xlsb")
If xl.ActiveWorkbook.ReadOnly = False Then Exit Do
Loop


If xl.ActiveWorkbook.ReadOnly = False Then

MsgBox ("read/write active")

'Run code
xl.Sheets("Sheet1").Range("G2").Value = 2222
xl.ActiveWorkbook.Save
xl.Quit

End If

xl.Quit
Set xl = Nothing

End Function

you need a loop to go through your files and call the function for every file. if the pattern of your filenames is something like this C:\\TEST\\TEST.xlsb, C:\\TEST\\TEST2.xlsb ,C:\\TEST\\TEST3.xlsb ,C:\\TEST\\TEST4.xlsb then you could for example implement another function to build the filename as a string and set it as a paramter of your function "test"

 Function goThroughFiles()
 Dim front as String
 Dim ending as String
 Dim i as Integer
 Dim strPath as String

 front = C:\TEST\TEST
 ending = .xlsb 
 i = 1

 // start with filename that has no number in it
 strPath = front & ending

 // check if file exists
 Do Until Len(Dir(strPath)) = 0 
    call test(strPath)
    i = i+1
    strPath = front & i & ending
 Loop

you need to change your original function, so it accepts a parameter:

  Function test(strPath as String)

and substitute every line that uses the path with your input variable

  xl.Workbooks.Open ("C:\TEST\Test.xlsb")

becomes

  xl.Workbooks.Open (strPath)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM