Sub ExportResources() Dim lastRow As Long: lastRow = CLng(1024) * CLng(1024) Dim resourceTable As New MSAccessTable resourceTable.DatabaseName = dbName resourceTable.TableName = "Resource" resourceTable.DeleteAllRecords Dim rs As ADODB.Recordset: Set rs = resourceTable.GetRecordForWriting() Dim resourceRequiredTrainingTable As New MSAccessTable resourceRequiredTrainingTable.DatabaseName = dbName resourceRequiredTrainingTable.TableName = "ResourceRequiredTraining" resourceRequiredTrainingTable.DeleteAllRecords Dim rsResReqTrain As ADODB.Recordset: Set rsResReqTrain = resourceRequiredTrainingTable.GetRecordForWriting() Dim r As Range: Set r = Range("ResourceColumnHeader") Do While True Set r = r.Offset(1) If Len(r.Value) = 0 Then Set r = r.End(xlDown) End If If r.Row = lastRow Then Exit Do ' get the resource name Dim resource As String: resource = r.Value ' get the group name Dim g As Range: Set g = r.Next(, -1).End(xlUp) Dim group As String: group = g.Value ' get the location name Dim l As Range: Set l = r.Next(, 1) Dim location As String: location = l.Value ' Write a new record to the table. With rs .AddNew .Fields("Group") = group .Fields("Resource") = resource .Fields("Location") = location .Update End With ExportResourceRequiredTrainingRow r, group, rsResReqTrain Loop End Sub
Advertisement
160
pages
Excel VBA example to write to an Access table
Advertisement