2024年3月27日发(作者：)

ImportHAWBData = True

Exit Function

Err_ImportHAWBData:

MsgBox ption

ImportHAWBData = False

End Function

Private Sub ImportExcelData()

'

On Error GoTo Err_ImportExcelData

Dim strFile As String

Dim strB1() As String, intTmp1 As Integer

"DELETE * FROM APTmp "

en

strFile = me

strFile

If strFile = "" Then

MsgBox "没有选择文件", vbCritical, "错误"

Exit Sub

End If

Set excelfile = New ation

Set excelwbook = (strFile)

Set excelsheet = (1)

lastCol =

lastRow =

lastCol

lastRow

(1, 1)

strB1 = Split(strFile, "")

intTmp1 = UBound(strB1)

strFile = strB1(intTmp1)

strFile

' If checkFileName(strFile) = True Then

' MsgBox "此文件名已经导入过,不可再导入", vbCritical, "错误"

' Exit Sub

' End If

Call ImportAPData(strFile)

Set excelfile = Nothing

Set excelwbook = Nothing

Exit_ImportExcelData:

Exit Sub

Err_ImportExcelData:

MsgBox ption

Resume Exit_ImportExcelData

End Sub

Private Sub ImportAPData(strTmp1 As String)

'

Dim i2 As Long

For i2 = 2 To lastRow

(i2, 7)

If checkDN(Trim(CStr((i2, 7))), "APT") = True Then

'----2012/7/25--更新添加R8TS的规则，其规则为当ROUTE字段为CMBLP1时自动添

加时间戳为分单号

' 1 2 3 4 5

6 7 8

strSQL = "INSERT INTO APTmp ( OrderType, CreateDate, GIdate, ShipTo, Route,

OriginDoc, DeliveryNum, HAWB ) "

strSQL = strSQL + "VALUES('" + Trim(CStr((i2, 1))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 2))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 3))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 4))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 5))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 6))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 7))) + "', "

If checkRoute(Trim(CStr((i2, 5)))) = False Then

strSQL = strSQL + "'" + Trim(CStr((i2, 8))) + "') "

Else

strSQL = strSQL + "'" + addR8TSHAWB + "')"

End If

' strSQL = strSQL + "'" + strTmp1 + "'" + ") "

strSQL

strSQL

End If

Next i2

Call ImportTAPData

End Sub

Private Sub ImportExcelFile()

'

Error = True

en

strFile = me

If me = "" Then

Exit Sub

End If

strFile

If strFile = "" Then

MsgBox "没有选择文件", vbCritical, "错误"

End If

Set excelfile = New ation

Set excelwbook = (strFile)

Set excelsheet = (1)

lastCol =

lastRow =

lastCol

lastRow

Call importHEADFile

Set excelfile = Nothing

Set excelwbook = Nothing

End Sub

Private Sub Command10_Click() '导入分单

On Error GoTo Err_Command10_Click

Dim strFile As String

en

strFile = me

strFile

If strFile = "" Then

MsgBox "没有选择文件", vbCritical, "错误"

Exit Sub

End If

Set excelfile = New ation

Set excelwbook = (strFile)

Set excelsheet = (1)

lastCol =

lastRow =

lastCol

lastRow

(1, 1)

If ImportHAWBData = False Then

MsgBox "导入未成功，请检查文件中有没有重复的DN", vbCritical, "提示"

' Exit Sub

End If

Call updateHAWB

Set excelfile = Nothing

Set excelwbook = Nothing

Exit_Command10_Click:

Exit Sub

Err_Command10_Click:

MsgBox ption

Resume Exit_Command10_Click

End Sub

Public Function ImportHAWBData() As Boolean

'

On Error GoTo Err_ImportHAWBData

Dim i7 As Long

Dim rst1 As set

strSQL = "SELECT , , RT "

strSQL = strSQL + "FROM HAWBTmp; "

strSQL

Set rst1 = cordset(strSQL)

For i7 = 2 To lastRow

(i7, 1)

If (i7, 1) <> "" And (i7, 2) <> "" Then

If checkDN(Trim(CStr((i7, 1)))) = True Then

(0) = Trim(CStr((i7, 1)))

(1) = Trim(CStr((i7, 2)))

End If

End If

Next i7

ImportHAWBData = True

Exit Function

Err_ImportHAWBData:

MsgBox ption

ImportHAWBData = False

End Function

Private Sub ImportExcelData()

'

Dim strFile As String

Dim strB1() As String

Dim intTmp1 As Integer

' "DELETE * FROM APTmp "

en

strFile = me

strFile

If strFile = "" Then

MsgBox "没有选择文件", vbCritical, "错误"

Exit Sub

End If

Set excelfile = New ation

Set excelwbook = (strFile)

Set excelsheet = (1)

lastCol =

lastRow =

lastCol

lastRow

(1, 1)

strB1 = Split(strFile, "")

intTmp1 = UBound(strB1)

strFile = strB1(intTmp1)

strFile

Call ImportItemData(strFile)

Call updateDN

Set excelfile = Nothing

Set excelwbook = Nothing

y

End Sub

' strB1 = Split(strFile, "")

' intTmp1 = UBound(strB1)

' strFile = strB1(intTmp1)

' strFile

Private Sub ImportItemData(strTmp1 As String)

'

Dim i2 As Long

For i2 = 2 To lastRow

(i2, 1)

strSQL = "INSERT INTO ITEM ( DNNo, Item, Material, Route, Refdoc, DlvQty, SU,

AcGIDate, QTY, IFN ) "

strSQL = strSQL + "VALUES('" + Trim(CStr((i2, 1))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 2))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 6))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 8))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 9))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 13))) + "',"

strSQL = strSQL + "'" + Trim(CStr((i2, 14))) + "',"

strSQL = strSQL + "#" + Trim(CStr((i2, 15))) + "#,"

strSQL = strSQL + "'" + Trim(CStr((i2, 17))) + "',"

strSQL = strSQL + "'" + strTmp1 + "' "

strSQL = strSQL + "); "

strSQL

strSQL

Next i2

End Sub