下面是完整的函数：

Sub getOrderNo()

Dim DSN_ID As String
Dim User_ID As String
Dim Password_ID As String
Dim DB_ID As String
Dim found As Boolean
Dim ProcNo As String
Dim colNumber As Integer
Dim colDiff As Integer
Dim Controller As String
Dim lineNotFound As Boolean
Dim activeRows
Dim dteDetailDate As Date

lineNotFound = False

colDiff = 5
found = False

DSN_ID = UCase(Sheets("Params").Range("F4").Value)
User_ID = UCase(Sheets("Params").Range("F5").Value)
Password_ID = UCase(Sheets("Params").Range("F6").Value)
DB_ID = UCase(Sheets("Params").Range("F7").Value)

Dim curSheet As String
curSheet = ActiveSheet.Name

Sheets(curSheet).Select

'Create the connection
    Set cnn1 = New ADODB.Connection
    Set cmdSQL = New ADODB.Command
    Dim recindex As New ADODB.Recordset
    
    cnn1.ConnectionTimeout = 5000
    cnn1.CommandTimeout = 500
    
    With cnn1
            .ConnectionString = "DSN=" & DSN_ID & ";UID=" & User_ID & _
                 ";PWD=" & Password_ID & ";DBQ=" & DB_ID & ";ASY=OFF;"
            .Open
            
    End With
    
    Controller = Sheets("Planning1").Range("D5").Value
    
    dteDetailDate = Sheets("detail").Range("I" & CalculateNewCell(11)).Value
              
    strSQL = "SELECT SSI_MBF010_VIEW.WORDNO, SSI_MBF010_VIEW.PARTNO_WOR,  procno_wor || '_' || PROCVER_WOR as procno_wor, SSI_MBF010_VIEW.PRLINE,           (SSI_MBF010_VIEW.WORDQTY) ForQty, (SSI_MBF010_VIEW.WORDQTYDEL), SSI_MBF010_VIEW.WORDSTART, SSI_MBF010_VIEW.WORDUE, WORDREF2 " & _
             "FROM mbg460 mbg460, SSI_MBF010_VIEW SSI_MBF010_VIEW " & _
             "WHERE SSI_MBF010_VIEW.PARTNO_WOR = mbg460.PARTNO_PTS AND ((mbg460.SALEPART='Y') AND WORDREF1 = 'WEEK' AND (SSI_MBF010_VIEW.CONTROLLER_WOR = '" & Controller & "') AND ((WORDQTY-WORDQTYDEL)>0) AND (SSI_MBF010_VIEW.PROCSTAGE_WOR='00000')  AND (TO_CHAR(WORDSTART,'D')='1')) AND WORDSTART > '" & Format(dteDetailDate - 1, "DD-MMM-YY") & "'"            
       
    Debug.Print strSQL
    
    Set recindex = cnn1.Execute(strSQL)
    
    Dim result As Variant
    result = recindex.GetRows
        
    seqRow = 0
    
    If Not (recindex.BOF And recindex.EOF) Then 'record(s) found
        recindex.MoveFirst
        colNumber = 0
        Dim ProcNo2 As String
        Do While Not recindex.EOF
            r = 0
            ProcNo = recindex("procno_wor")
           
            found = False
            Do While Not found
             If Len(Sheets("detail").Range("C" & CalculateNewCell(14)).Offset(r, 0).Value) > 0 Then
                 ProcNo2 = CStr(Left(Sheets("detail").Range("C" & CalculateNewCell(14)).Offset(r, 0).Value, Len(Sheets("detail").Range("C" & CalculateNewCell(14)).Offset(r, 0).Value) - 2))
                Else
                 ProcNo2 = ""
                End If
                
                If ProcNo2 = "" Then
                    MsgBox "Process version " & recindex("procno_wor") & " has WO that exist in Tropos but the process cannot be found in this Detail Sheet. Process has been made Historic but WO " & recindex("wordno") & " still exists in Tropos.   ", vbInformation, "Information"
                    found = True
                End If
                If ProcNo = ProcNo2 Then
                   found = True
                   reqdue = recindex("wordue")
                    
                   colNumber = 8 + ((colDiff * (reqdue - dteDetailDate) / 7))
                   ''''''KB
                      If r = 1 Then
                        Debug.Print 'here'
                    End If

                   Sheets("detail").Range("C" & CalculateNewCell(14)).Offset(r, colNumber).Value = recindex("wordno").Value
                   Sheets("detail").Range("C" & CalculateNewCell(14)).Offset(r, colNumber - 1).Value = CStr(recindex("ForQty").Value)
                    
                   If CStr(recindex("wordref2").Value) <> " " Then
                   Dim msg
                        msg = "Return Date " & CStr(recindex("wordref2").Value)
                        Call addComments(msg, "detail", "C" & CalculateNewCell(14), r, colNumber - 1)
                   End If
                   
                   Dim PRline, Desc
                   PRline = Sheets("detail").Range("E" & CalculateNewCell(14)).Offset(r, 0).Value
                   Desc = Sheets("detail").Range("B" & CalculateNewCell(14)).Offset(r, 0).Value
                                    
                End If
                r = r + 1
            Loop
            recindex.MoveNext
        Loop
    End If
    
    If lineNotFound Then
        MsgBox "One or more lines have no Efficiency factor. for more details check C:\LogFile\Error", vbInformation, "Information"
        lineNotFound = False
    End If
    
    Set cnn1 = Nothing
    Set recindex = Nothing
End Sub