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!
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