Excel VBA-Makro, um Tabelle Wert mit SQL Server-Tabelle

Question

Ich habe Makro, die den Zellenwert von Excel-Spalte A und überprüft diesen Wert in der SQL-Server db und gibt die Daten in der Tabelle. Jetzt muss ich zwei Spalten aus der Tabellenkalkulationsspalte A und Spalte B abgleichen und wenn die Bedingung wahr ist, alle Daten in der Tabelle zurückgeben. Mein Makro funktioniert gut mit einzelnem Zustand (für Spalte A), aber wenn ich meine SQL-Anweisung in dem Makro bearbeiten zweite Bedingung enthält (für Spalte F) Ich erhalte eine Fehlermeldung

Runtime error 2147217913 800040e07.

Hier ist mein Makro:

Sub GetSQLData() 

Dim conn As ADODB.Connection 
Dim rs As ADODB.Recordset 
Dim sConnString As String 
Dim newrow As String 


'MODIFIED: create the search string for the IN-Statement 
newrow = "(" 
For i = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row 
    newrow = newrow & "'" & Left(Trim(Worksheets("Sheet1").Cells(i, "A").Value), 7) & "'," 

Next i 

newrow2 = "(" 
For j = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "F").End(xlUp).Row 
    newrow2 = newrow2 & "'" & Left(Trim(Worksheets("Sheet1").Cells(j, "F").Value), 7) & "'," 

Next j 


'QueryDatabase: 
newrow = Left(newrow, Len(newrow) - 1) 
newrow = newrow & ")" 

newrow2 = Left(newrow2, Len(newrow2) - 1) 
newrow2 = newrow2 & ")" 

' Create the connection string. 
sConnString = "Provider=SQLOLEDB;Data Source=0.0.0.0;" & _ 
        "Initial Catalog=Shipment;" & _ 
        "User ID=Temp;Password=test123;" 



' Create the Connection and Recordset objects. 
Set conn = New ADODB.Connection 
Set rs = New ADODB.Recordset 

' Open the connection and execute. 
conn.Open sConnString 

Set rs = conn.Execute("SELECT 'Message' = Case When s.ShipmentID is not Null Then 'Error: Already Loaded' When IsNull(j.Invoice_Number, 0) <> 0 Then 'Error: Already Invoiced' Else 'Ready to Upload' End,convert(varchar(10), s.[ShipDate], 120)'Ship_date', j.[num2],j.[customer], s.[ShipPickUpCompany], s.[ShipPickUpCity],s.[ShipPickUpState],s.[ShipDeliveryCompany],s.[ShipDeliveryCity],s.[ShipDeliveryState],'Service' = 'Truck',s.[ShipCost],s.[ShipType], s.[Shipqty], 'Tracking' = LTRIM(RTRIM(Convert(Char(10), s.[ShipDate], 101))) + ' - ' + LTRIM(RTRIM(convert(Char(10),s.[Shipqty],101)))+ ' - ' + LTRIM(RTRIM(j.[Project_description])), s.[ShipPaid], S.[ShipReasonPaid], isnull(s.[ShipPrice],'')'ShipPrice' , s.[ShipHandlingPrice],j.Invoice_Number, case when isnull(j.Invoice_Number,'') = 0 then 'NotInvoiced' else 'Invoiced' end 'InvoiceStatus' FROM [shipment].[dbo].[num_tab] j left join [shipment].[dbo].[Tracking] s on s.ShipNum = j.num2 " & _ 
         "where j.[num2] IN " & Trim(newrow) & " AND S.[Shipqty] IN " & Trim(newrow2) & " ") 


' Check we have data. 
If Not rs.EOF Then 
    ' Transfer result. 

     'Sheets(1).Cells("B1").CopyFromRecordset rs 
     Do Until rs.EOF = True 
      For i = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row 
       For j = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "F").End(xlUp).Row 
       Worksheets("Sheet1").Range("J1:AD1") = Array("Message", "ShipDate", "JobNumber", "Customer", "FromCompany", "FromCity", "FromState", "ToCompany", "ToCity", "ToState", "ShipService", "ShipCost", "Type(F,P,S,R)", "Quantity", "TrackingNumber", "Paid(Y,N)?", "PaidReason(C,E,M,F,P)", "ShipPrice", "HandlingPrice", "Invoice_Number", "InvoiceStatus") 

      If Trim(rs("num2").Value) = Left(Trim(Sheets(1).Cells(i, "A").Value), 7) And Trim(rs("shipqty").Value) = Left(Trim(Sheets(1).Cells(j, "F").Value), 7) Then 
           Sheets(1).Cells(i, "J").Value = rs("Message").Value 
           Sheets(1).Cells(i, "K").Value = rs("Ship_Date").Value 
           Sheets(1).Cells(i, "L").Value = rs("num2").Value 
           Sheets(1).Cells(i, "M").Value = rs("customer").Value 
           Sheets(1).Cells(i, "N").Value = rs("ShipPickUpCompany").Value 
           Sheets(1).Cells(i, "O").Value = rs("ShipPickUpCity").Value 
           Sheets(1).Cells(i, "P").Value = rs("ShipPickUpState").Value 
           Sheets(1).Cells(i, "Q").Value = rs("ShipDeliveryCompany").Value 
           Sheets(1).Cells(i, "R").Value = rs("ShipDeliveryCity").Value 
           Sheets(1).Cells(i, "S").Value = rs("ShipDeliveryState").Value 
           Sheets(1).Cells(i, "T").Value = rs("Service").Value 
           Sheets(1).Cells(i, "U").Value = rs("ShipCost").Value 
           Sheets(1).Cells(i, "V").Value = rs("ShipType").Value 
           Sheets(1).Cells(i, "W").Value = rs("Shipqty").Value 
           Sheets(1).Cells(i, "X").Value = rs("Tracking").Value 
           Sheets(1).Cells(i, "Y").Value = rs("ShipPaid").Value 
           Sheets(1).Cells(i, "Z").Value = rs("ShipReasonPaid").Value 
           Sheets(1).Cells(i, "AA").Value = rs("ShipPrice").Value 
           Sheets(1).Cells(i, "AB").Value = rs("ShipHandlingPrice").Value 
           Sheets(1).Cells(i, "AC").Value = rs("Invoice_Number").Value 
           Sheets(1).Cells(i, "AD").Value = rs("InvoiceStatus").Value 

          End If 
      Next j 
      Next i 

     rs.MoveNext 
     Loop 




' Close the recordset 
    rs.Close 
Else 
    MsgBox "Error: No records returned.", vbCritical 

End If 

' Clean up 
If CBool(conn.State And adStateOpen) Then conn.Close 
Set conn = Nothing 
Set rs = Nothing 

End Sub 

Answer 1

Eine Websuche hätte Ihnen die Antwort im allerersten Ergebnis gegeben. Sie erhalten einen Datentyp-Mismatch-Fehler. Dies liegt wahrscheinlich daran, dass Ihre Spalte F Werte enthält, die Sie nicht erwarten. Sie können dies überprüfen, indem Sie eine debug.print Ihrer SELECT-Anweisung ausführen.

Sie scheinen Ihren newrow und newrow2 mit numerischen Werten wie Versandmenge zu vergleichen (dies ist eine Schätzung basierend auf den Spaltennamen). Wenn dies der Fall ist, sollten Sie die einzelnen Werte, die Sie in newrow und newrow2 hinzufügen, nochmals in Anführungszeichen setzen.

Können Sie den Fehler überprüfen: ist es 80040e07 oder 800040e07 wie Sie gepostet?