For Each problem

[Piotr]

Hi,
in following code I have problem as it doesnt execute for every sheet
in workbook ... i cant find the bug as it looks properly

Sub DAO_Import_planow_do_access()
' exports data from the active worksheet to a table in an Access
database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Dim kanal As String
Dim WS As Worksheet


For Each WS In ThisWorkbook.Worksheets

Set db = OpenDatabase("D:\bazy\plany.mdb")
' open the database
Set rs = db.OpenRecordset("plany", dbOpenTable)
' get all records in a table

r = 1476 ' the start row in the worksheet
kanal = ActiveSheet.Name
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("brend") = Range("A" & r).Value
.Fields("group") = Range("B" & r).Value
.Fields("name") = Range("C" & r).Value
.Fields("quantity") = Range("D" & r).Value
.Fields("channel") = kanal
.Fields("month") = Range("F" & r).Value
.Fields("value") = Range("G" & r).Value
.Fields("file") = ActiveWorkbook.Name
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
Next WS
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing


End Sub

 

[Bob Phillips]

Untested.

mport_planow_do_access()
' exports data from the active worksheet to a table in an Access
database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Dim kanal As String
Dim WS As Worksheet


For Each WS In ThisWorkbook.Worksheets

Set db = OpenDatabase("D:\bazy\plany.mdb")
' open the database
Set rs = db.OpenRecordset("plany", dbOpenTable)
' get all records in a table

r = 1476 ' the start row in the worksheet
kanal = Wsame
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("brend") = WS.Range("A" & r).Value
.Fields("group") = WS.Range("B" & r).Value
.Fields("name") = WS.Range("C" & r).Value
.Fields("quantity") = WS.Range("D" & r).Value
.Fields("channel") = kanal
.Fields("month") = WS.Range("F" & r).Value
.Fields("value") = WS.Range("G" & r).Value
.Fields("file") = ActiveWorkbook.Name
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
Next WS
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing


End Sub
--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Piotr]

I have tried it still doesnt take all sheets from the file ... strange

 

[Norman Jones]

Hi Piotr,

Have you tried stepping through the code to find where your expectation and
the code part company?

Is it possible that the sheet which is not processed, has an A1476 cell
which returns a value <= 0? If this were the case, the code would jump to
the next sheet.

 

[Piotr]

I have checked, every sheet has string value in A1476 so that could not
be a problem.
The most strange is that after i have changed code up to re: post, the
script is going throgh 4 sheets in every file ?

regards
Peter