I am trying to loop through the code below to retrieve data from MsAcess in to about 60 worksheets. Each worksheet is named after its cost centre code. In the MsAcess table the data relating to each worksheet is also identified by the cost centre code in one of the fields. By reading the worksheetname and substituting it in the macro I can therefore relate each worksheet to the right data. The macro runs well but retrieves the wrong data.
Will someone tell me what is wrong??
the macro is:
Sub MsAccessData()
Dim ws As Worksheet
Dim allwShts As Sheets
Dim SheetName, SheetNames, NewName As String
Dim B10, b11 As Variant
Set allwShts = Worksheets
Sheets(1).Select
For Each ws In allwShts
'
Sheets(1).Activate
B10 = ActiveSheet.Name
'With ws
'.Move after:=Worksheets(Worksheets.Count)
'.Range("c16:h500".ClearContents
'End With
'Sheets(& b10 ).Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Documents and Settings\eoitu\Desktop\Budget\db3.mdb;DefaultDir=C:\Documents and Settings\eoitu\De" _
), Array( _
"sktop\Budget;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"), _
Destination:=Range("C16:G500")
.CommandText = Array( _
"SELECT bbjournal.PERIOD, bbjournal.CC, bbjournal.ACCT, bbjournal.ORG, bbjournal.ToPost" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\eoitu\Desktop\Budget\db3.bbjournal bbjournal" & Chr(13) & "" & Chr(10) & "WHERE (bbjournal.ToPost>=10) AND " _
, _
"(bbjournal.CC=" & B10 & " OR (bbjournal.ToPost<=-10) AND (bbjournal.CC=" & B10 & "" & Chr(13) & "" & Chr(10) & "ORDER BY bbjournal.PERIOD, bbjournal.ACCT" _
)
.Name = "qry_" & B10
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
''.Refresh BackgroundQuery:=False
End With
ws.Move after:=Worksheets(Worksheets.Count)
Next ws
End Sub
Will someone tell me what is wrong??
the macro is:
Sub MsAccessData()
Dim ws As Worksheet
Dim allwShts As Sheets
Dim SheetName, SheetNames, NewName As String
Dim B10, b11 As Variant
Set allwShts = Worksheets
Sheets(1).Select
For Each ws In allwShts
'
Sheets(1).Activate
B10 = ActiveSheet.Name
'With ws
'.Move after:=Worksheets(Worksheets.Count)
'.Range("c16:h500".ClearContents
'End With
'Sheets(& b10 ).Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=C:\Documents and Settings\eoitu\Desktop\Budget\db3.mdb;DefaultDir=C:\Documents and Settings\eoitu\De" _
), Array( _
"sktop\Budget;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"), _
Destination:=Range("C16:G500")
.CommandText = Array( _
"SELECT bbjournal.PERIOD, bbjournal.CC, bbjournal.ACCT, bbjournal.ORG, bbjournal.ToPost" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\eoitu\Desktop\Budget\db3.bbjournal bbjournal" & Chr(13) & "" & Chr(10) & "WHERE (bbjournal.ToPost>=10) AND " _
, _
"(bbjournal.CC=" & B10 & " OR (bbjournal.ToPost<=-10) AND (bbjournal.CC=" & B10 & "" & Chr(13) & "" & Chr(10) & "ORDER BY bbjournal.PERIOD, bbjournal.ACCT" _
)
.Name = "qry_" & B10
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
''.Refresh BackgroundQuery:=False
End With
ws.Move after:=Worksheets(Worksheets.Count)
Next ws
End Sub