vba_dpcode_check

Sub DPcode()


arr = Selection
brr = Split(Selection.Address, "$")

lie = Range(brr(1) & 1).Column
hang = Split(brr(2), ":")(0)


Set conn = CreateObject("adodb.connection")
Set rst = CreateObject("ADODB.recordset")

conn.Open "provider=Microsoft.ace.OLEDB.12.0;data source=" & "\\Cngscapl-spf303\Customer_Care\Doc_Import\Share\AM Team\01 IB - LARA\15 Personal Folder\bOB\Database_Bob.accdb"
 

rst.Open "select *,Ship_Angecy.Port & Ship_Angecy.Voyage as PV from Department_Code left join Ship_Angecy on Department_Code.Port = Ship_Angecy.Port", conn, adOpenKeyset, adLockOptimistic

crr = rst.GetRows

Dim port, PV


For i = 1 To UBound(arr)


port = arr(i, 2)

rst.Find "Department_Code.Port= '" & port & "'", , , 1

If (Len(arr(i, 1)) > 6 And Right(arr(i, 1), 2) = "MA") Or Len(arr(i, 1)) <= 6 Then

Cells(Split(brr(2), ":")(0) + j, Range(brr(1) & 1).Column + 2) = rst.Fields(3)

ElseIf Len(arr(i, 1)) > 6 And Right(arr(i, 1), 2) = "NL" Then

Cells(Split(brr(2), ":")(0) + j, Range(brr(1) & 1).Column + 2) = rst.Fields(4)

ElseIf Len(arr(i, 1)) > 6 And Right(arr(i, 1), 2) = "NC" Then

Cells(Split(brr(2), ":")(0) + j, Range(brr(1) & 1).Column + 2) = rst.Fields(5)

End If


'jiaru huodai

On Error Resume Next

PV = arr(i, 2) & Left(arr(i, 1), 3)

rst.Find "PV= '" & PV & "'", , , 1


If Len(arr(i, 1)) > 6 Then

Cells(Split(brr(2), ":")(0) + j, Range(brr(1) & 1).Column + 3) = rst.Fields(9)

Cells(Split(brr(2), ":")(0) + j, Range(brr(1) & 1).Column + 4) = rst.Fields(10)

End If

On Error GoTo 0


j = j + 1

Next i


End Sub