Using Access VBA to Loop through Excel Rows

cathie

Registered User.
Local time
Today, 00:40
Joined
Oct 21, 2017
Messages
10
I have the following code and have searched the 'net extensively to try to help find a solution and I am having no luck at all. I want to open and loop through an excel file in a specific format which on the face seems simple enough. I want to take the values from that spreadsheet and do some API calls to Zillow to see if the values equate to a valid address. After all this, I want to write a record into the table and flag it as a Duplicate or New record.

I am getting Run-time Errors 438 and 1004.

Please HELP! Any assistance would be greatly appreciated!


Code:
Sub Upload_Excel_Click()

If Me.Text60.Value = "" Then
    userans = MsgBox("There is no file selected to process", vbOKOnly, "Unable to Upload File")
    Exit Sub
End If

Dim XlApp As Object
Dim wb As Object
Dim sht As Object
Dim rng As Object
Dim myfilename As String

myfilename = Me.Text60.Value

Set XlApp = CreateObject("Excel.Application")
XlApp.Application.ScreenUpdating = False
    
Set wb = XlApp.Workbooks.Open(myfilename)
Set sht = wb.Worksheets(1)

wb.Activate

Vendor = Me.Vendor.Value
DateRcvd = Me.Date_Rec_d.Value
Wholesaler = Me.Combo55.Value
Processed = 1
UploadID = DMax("UploadID", "All2") + 1

ZWSID = "X1-Z000000000000"

Dim xmldoc As MSXML2.DOMDocument60
Dim xmlNodeList As MSXML2.IXMLDOMNodeList
Dim myNode As MSXML2.IXMLDOMNode

For Each cell In wb.UsedRange.cells
    
    If cell.Value = "Loan Type" Then
        startrow = cell.Row
        startcol = cell.Column
        
        Set rng = sht.cells(startrow + 1, startcol).CurrentRegion
        ReDim strarray(0 To 6) As String
        For r = startrow + 1 To ((startrow + 1 + rng.rows.Count) - 1)
            i = 0
            For c = startcol To 7
                strarray(i) = sht.cells(r, c)
                i = i + 1
                If c = 8 Then
                    DoCmd.SetWarnings False
                    LoanType = Trim(strarray(0))
                    Street = Trim(strarray(1))
                    Street = Replace(Street, " ", "+")
                    Unit = Trim(strarray(2))
                    Unit = Replace(Unit, " ", "+")
                    City = Trim(strarray(3))
                    City = Replace(City, " ", "+")
                    State = Trim(strarray(4))
                    Zip = Trim(strarray(5))
                    Borrower = Trim(strarray(6))
                    Latitude = ""
                    Longitude = ""
                    ZillowID = ""
                    Zestimate = ""
                    ZRestimate = ""
                    ZError = ""
                    Result = 3
    
                    If Unit <> "" Then
                        Street = Street & "+" & Unit
                    End If
                    
                    URL = "(I had to remove to post)webservice/GetSearchResults.htm?zws-id=" & ZWSID & "&address=" & _
                            Street & "&citystatezip=" & City & "%2C+" & State & "%2C+" & Zip & _
                            "&rentzestimate=true"
                    
                    Set xmldoc = New MSXML2.DOMDocument60
                    xmldoc.async = False
                    
                    If xmldoc.Load(URL) Then
                    
                        Set xmlMessage = xmldoc.SelectSingleNode("//message/text")
                        Set xmlMessageCode = xmldoc.SelectSingleNode("//message/code")
                    
                        If xmlMessageCode.Text <> 0 Then
                   	    ZError = xmlMessage.Text                    
                        Else
                            Set xmlpropertyID = xmldoc.SelectSingleNode("//response/results/result/zpid")
                            If xmlpropertyID Is Nothing Then
                                ZillowID = "NO PROPERTY ID ON FILE"
                            Else
                                ZillowID = xmlpropertyID.Text
                            End If
                            Set xmlLatitude = xmldoc.SelectSingleNode("//response/results/result/address/latitude")
                            Set xmlLongitude = xmldoc.SelectSingleNode("//response/results/result/address/longitude")
                            Latitude = xmlLatitude.Text
                            Longitude = xmlLongitude.Text
                    
                            Set xmlZAmount = xmldoc.SelectSingleNode("//response/results/result/zestimate/amount")

                            Zestimate = xmlZAmount.Text
                            Zestimate = Format(Zestimate, "#0.00")
                    
                            Set xmlRZAmount = xmldoc.SelectSingleNode("//response/results/result/rentzestimate/amount")
                            If xmlRZAmount Is Nothing Then
                                ZRestimate = 0
                            Else
                                ZRestimate = xmlRZAmount.Text
                                ZRestimate = Format(ZRestimate, "#0.00")
                            End If
                            If DCount("*", "All2", "[ZillowID] = '" & ZillowID & "'") > 0 Then
                                Result = 2
                            Else
                                Result = 1
                            End If
                            
                            MySql = "INSERT INTO All2 (LoanType, Street, Unit, City, State, Zip, Borrower, Vendor, DateRecd, Wholesaler, Processed, " & _
                                                "UploadID, Result, Latitude, Longitude, ZillowID, Zestimate, ZRestimate, Zerror) VALUES " & _
                                                "('" & LoanType & "','" & Street & "','" & Unit & "','" & City & "','" & State & "','" & Zip & _
                                                "','" & Borrower & "'," & Vendor & ",#" & DateRcvd & "#," & Wholesaler & "," & Processed & _
                                                "," & UploadID & "," & Result & ",'" & Latitude & "','" & Longitude & "','" & ZillowID & _
                                                "'," & Zestimate & "," & ZRestimate & ",'" & ZError & "'" & ");"
                            DoCmd.RunSQL MySql
                            Erase strarray
                            ReDim strarray(0 To 6)
                        End If
                    Else
                        ZError = "The document failed to load"
                    End If
                End If
            Next c
        Next r
    Else
        userans = MsgBox("Please put the data in the proper format and try again", vbOKOnly, "Invalid Data Format")
    End If

Next

If Not (XlApp Is Nothing) Then XlApp.Quit

End Sub
 
you need to debug your code to
determine which line gets the fault.
on the first line of the Upload_Excel_Click(),
press F9. go back to the form and press the button
when ready. press F8 to step through the code.
note and post which part of the code gets the error.
 

Users who are viewing this thread

Back
Top Bottom