Automatic RLC Campaign in VBA (with OAS Integration DLL)

OAS RLC with VBA

Option Explicit

Const xmlRLC As String = "<AdXML><Request type=""Campaign""><Campaign action=""run""><RunLiveCampaigns/></Campaign></Request></AdXML>"
Const xmlRLCStatus As String = "<AdXML><Request type=""Campaign""><Campaign action=""run""><LastStatusRLC/></Campaign></Request></AdXML>"

Public Enum CallType
    RLC = 0
    Status = 1
End Enum

Public Sub ExecuteRLC()
    CallOAS RLC
End Sub

Public Sub RLCStatus()
    CallOAS Status
End Sub

Private Sub CallOAS(Operation As CallType)
    Dim i As Integer
    Dim OAS As New OASAPI
    Dim CRng As Range
    Dim rtnXML As New DOMDocument60
    Dim xmlList As IXMLDOMNodeList
    
    'Inicializar Objeto de API
    OAS.UserId = Sheets("Dados").Range("C1").Value
    OAS.Password = Sheets("Dados").Range("C2").Value
    OAS.WebAddress = Sheets("Dados").Range("C3").Value
    
    With Sheets("Accounts")
        For i = 3 To Application.WorksheetFunction.CountA(.Range("B3:B10000"))
            Set CRng = .Range("A" & i & ":G" & i)
            
            If CRng.Columns(5) = "X" Then
                OAS.AccountID = CRng.Columns(2)
                
                Select Case Operation
                    Case RLC
                        CRng.Columns(3) = Now()
                        If rtnXML.LoadXML(OAS.SendAdXML(xmlRLC)) Then
                            Set xmlList = rtnXML.SelectNodes("/AdXML/Response/Campaign/RunLiveCampaigns")
                            CRng.Columns(4) = Now()
                            If xmlList.Length > 0 Then CRng.Columns(6) = xmlList.Item(0).Text
                        End If
                    Case Status
                        If rtnXML.LoadXML(OAS.SendAdXML(xmlRLCStatus)) Then
                            Set xmlList = rtnXML.SelectNodes("/AdXML/Response/Campaign/LastStatusRLC")
                            If xmlList.Length > 0 Then CRng.Columns(7) = xmlList.Item(0).Text
                        End If
                End Select
            End If
        Next i
    End With
    
    Set OAS = Nothing
End Sub

OASRLCwithVBA

Option Explicit

Const xmlRLC As String = "<AdXML><Request type=""Campaign""><Campaign action=""run""><RunLiveCampaigns/></Campaign></Request></AdXML>"
Const xmlRLCStatus As String = "<AdXML><Request type=""Campaign""><Campaign action=""run""><LastStatusRLC/></Campaign></Request></AdXML>"

Public Enum CallType
    RLC = 0
    Status = 1
End Enum

Public Sub ExecuteRLC()
    CallOAS RLC
End Sub

Public Sub RLCStatus()
    CallOAS Status
End Sub

Private Sub CallOAS(Operation As CallType)
    Dim i As Integer
    Dim OAS As New OASAPI
    Dim CRng As Range
    Dim rtnXML As New DOMDocument60
    Dim xmlList As IXMLDOMNodeList
    
    'Initialize API Object
    OAS.UserId = Sheets("Dados").Range("C1").Value
    OAS.Password = Sheets("Dados").Range("C2").Value
    OAS.WebAddress = Sheets("Dados").Range("C3").Value
    
    With Sheets("Accounts")
        For i = 3 To Application.WorksheetFunction.CountA(.Range("B3:B10000"))
            Set CRng = .Range("A" & i & ":G" & i)
            
            If CRng.Columns(5) = "X" Then
                OAS.AccountID = CRng.Columns(2)
                
                Select Case Operation
                    Case RLC
                        CRng.Columns(3) = Now()
                        If rtnXML.LoadXML(OAS.SendAdXML(xmlRLC)) Then
                            Set xmlList = rtnXML.SelectNodes("/AdXML/Response/Campaign/RunLiveCampaigns")
                            CRng.Columns(4) = Now()
                            If xmlList.Length > 0 Then CRng.Columns(6) = xmlList.Item(0).Text
                        End If
                    Case Status
                        If rtnXML.LoadXML(OAS.SendAdXML(xmlRLCStatus)) Then
                            Set xmlList = rtnXML.SelectNodes("/AdXML/Response/Campaign/LastStatusRLC")
                            If xmlList.Length > 0 Then CRng.Columns(7) = xmlList.Item(0).Text
                        End If
                End Select
            End If
        Next i
    End With
    
    Set OAS = Nothing
End Sub