Excel VBAmacros将电子表格值与sql server表匹配
我有macros从Excel列A中取出单元格值，并在SQL Server数据库中检查该值，并在电子表格中返回数据。 现在我需要匹配电子表格列A和列B中的两列，如果条件为真，则返回电子表格中的所有数据。 我的macros工作正常单条件（列A），但是当我编辑我的SQL语句在macros中包括第二个条件（F列）我得到一个错误消息
运行时错误2147217913 800040e07。
这是我的macros：
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 networkingsearch会给你第一个结果的答案。 你得到一个数据types不匹配的错误。 这可能是因为你的列F有你不期待的值。 您可以通过执行SELECT语句的debug.print来检查。
你似乎正在比较你的newrow和newrow2与数字值如运费数量（这是一个基于列名称的猜测）。 如果是这样，您可能需要重新考虑将单引号添加到您添加到newrow和newrow2中的每个值中。
你可以检查错误：你张贴的是80040e07还是800040e07？