Question

我有一个基于excel单元格值查询SQL Server db的宏。在我的下面的宏中有sql case语句来检查货件ID是否存在：

'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

以上条件正常。目前，我的宏填充了上述“错误”条件的电子表格。如果没有“错误”消息，我只需要填充电子表格。

以下是我的宏的完整代码：非常感谢任何帮助。感谢。

Sub GetSQLData()

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim newrow As String
Dim newrow2 As String
Dim newrow3 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

newrow3 = "("
For k = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "D").End(xlUp).Row
   newrow3 = newrow3 & "'" & Trim(Worksheets("Sheet1").Cells(k, "D").Value) & " - " & Trim(Worksheets("Sheet1").Cells(k, "C").Value) & "',"

Next k

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

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

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

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



' Create the Connection and Recordset objects.

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), 'ShipDate', 120)'Ship_date', j.[num2],j.[customer], 'FromCompany'='CSI', 'FromCity'='Test','FromState'='Test','ToCompany'='Temp','ToCity'='Pine','ToState'='Test','Service' = 'Truck',s.[ShipCost],'Type'='F', 'Quantity', 'Tracking' = LTRIM(RTRIM(Convert(Char(10), s.[ShipDate], 101))) + ' - ' + LTRIM(RTRIM(convert(Char(10),s.[Shipqty],101)))+ ' - ' + LTRIM(RTRIM(j.[Project_description])), 'SCIPaid'='Y', 'PaidReason'='C', 'ShipPrice'='0' , 'HandlingPrice'='0',j.Invoice_Number, case when isnull(j.Invoice_Number,'') = 0 then 'NotInvoiced' else 'Invoiced' end 'InvoiceStatus' FROM [asset].[dbo].[num_tab] j " & _
                        "left join [asset].[dbo].[ShipTracking] s on s.ShipJobNum = j.num2  AND convert(varchar(10),S.[Shipqty]) IN  " & newrow2 & " AND s.[ShipTracking] IN " & newrow3 & " " & _
                       "where j.[num2] IN " & Trim(newrow) & " ")


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


        Do Until rs.EOF = True
           For i = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row

              Worksheets("Sheet1").Range("J1:AE1") = Array("Message", "ShipDate", "JobNumber", "Customer", "FromCompany", "FromCity", "FromState", "ToCompany", "ToCity", "ToState", "ShipService", "ShipCost", "Type(F,P,S,R)", "Quantity", "TrackingNumber", "aid(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) Then

                                Sheets(1).Cells(i, "J").Value = rs("Message").Value
                                Sheets(1).Cells(i, "K").Value = Sheets(1).Cells(i, "D").Value
                                Sheets(1).Cells(i, "L").Value = rs("scinum2").Value
                                Sheets(1).Cells(i, "M").Value = rs("customer").Value
                                Sheets(1).Cells(i, "N").Value = rs("FromCompany").Value
                                Sheets(1).Cells(i, "O").Value = rs("FromCity").Value
                                Sheets(1).Cells(i, "P").Value = rs("FromState").Value
                                Sheets(1).Cells(i, "Q").Value = rs("ToCompany").Value
                                Sheets(1).Cells(i, "R").Value = rs("ToCity").Value
                                Sheets(1).Cells(i, "S").Value = rs("ToState").Value
                                Sheets(1).Cells(i, "T").Value = rs("Service").Value
                                Sheets(1).Cells(i, "U").Value = Sheets(1).Cells(i, "E").Value * Sheets(1).Cells(i, "F").Value
                                Sheets(1).Cells(i, "V").Value = rs("Type").Value
                                Sheets(1).Cells(i, "W").Value = Sheets(1).Cells(i, "F").Value
                                Sheets(1).Cells(i, "X").Value = Sheets(1).Cells(i, "D").Value & " - " & Sheets(1).Cells(i, "F").Value
                                Sheets(1).Cells(i, "Y").Value = rs("SCIPaid").Value
                                Sheets(1).Cells(i, "Z").Value = rs("PaidReason").Value
                                Sheets(1).Cells(i, "AA").Value = rs("ShipPrice").Value
                                Sheets(1).Cells(i, "AB").Value = rs("HandlingPrice").Value
                                Sheets(1).Cells(i, "AC").Value = rs("Invoice_Number").Value
                                Sheets(1).Cells(i, "AD").Value = rs("InvoiceStatus").Value

                             End If

            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

如果SQL条件为true，则停止宏以填充数据

0 个答案: