Zuma Lifeguard Wiki
Advertisement
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