Rainbow, я коннекчусь через ODBC
Sub SendXls()
Dim wrkPbd As Workspace
Dim dbsPbd As Database
Dim parentRecId1 As String
Dim systemID1 As String
Dim importbatch1 As String
Dim name1 As String
Dim transDate1 As String
Dim accountNum1 As String
Dim offsetAccount1 As String
Dim amountCurDebit1 As String
Dim txt1 As String
Dim dim1 As String
Dim dim2 As String
Dim dim3 As String
Dim dim4 As String
Dim dim5 As String
Dim dim6 As String
Dim dim7 As String
Dim dim8 As String
Dim strSQL As String
Dim cnt As Integer
Dim retCode As Integer
mUID = name_UID
mPWD = name_PWD
mDSN = name_DSN
systemID1 = identDoc
importbatch1 = nameDoc
name1 = nameJournal
mcodAxapta = codAxapta
miRow = iRow
If miRow < 2 Then
Exit Sub
End If
Windows(F_work).Activate
Sheets("pl_f").Select
strSQL = "BEGIN TRANSACTION" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SET DATEFORMAT dmy" & Chr$(10) & Chr$(12)
strSQL = strSQL & "DELETE EXP_LedgerJournalTrans" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE" & Chr$(10) & Chr$(12)
strSQL = strSQL & "ParentRecId=" & Chr$(10) & Chr$(12)
strSQL = strSQL & "(SELECT CAST(RecNo AS Varchar(20)) FROM EXP_LedgerJournalTable" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SystemID='" & systemID1 & "' AND" & Chr$(10) & Chr$(12)
strSQL = strSQL & "Name='" & name1 & "')" & Chr$(10) & Chr$(12)
strSQL = strSQL & "DELETE EXP_LedgerJournalTable" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SystemID='" & systemID1 & "' AND" & Chr$(10) & Chr$(12)
strSQL = strSQL & "Name='" & name1 & "'" & Chr$(10) & Chr$(12)
strSQL = strSQL & "INSERT EXP_LedgerJournalTable" & _
"(State,IMPORTBATCH,SystemID,ParentRecID,Name,Dimension) VALUES (0,'" & _
importbatch1 & "','" & systemID1 & "','0','" & name1 & "','" & mcodAxapta & "')" & Chr$(10) & Chr$(12)
strSQL = strSQL & "UPDATE EXP_LedgerJournalTable" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SET ParentRecID=RecNo" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE ParentRecID='0'" & Chr$(10) & Chr$(12)
cnt = 2
Do
transDate1 = Cells(cnt, 1)
' transDate1 = Mid(transDate1, 7, 4) & Mid(transDate1, 3, 4) & Mid(transDate1, 1, 2)
accountNum1 = Cells(cnt, 2)
offsetAccount1 = Cells(cnt, 3)
amountCurDebit1 = Cells(cnt, 4)
lenAm = Len(amountCurDebit1)
cntl = 1
prAmount = "1"
Do
prAm = Mid(amountCurDebit1, cntl, 1)
If prAm = "," Then prAm = "."
prAmount = prAmount & prAm
cntl = cntl + 1
Loop While cntl <= lenAm
amountCurDebit1 = Mid(prAmount, 2, lenAm)
txt1 = Cells(cnt, 5)
dim1 = Cells(cnt, 6)
dim2 = Cells(cnt, 7)
dim3 = Cells(cnt,
dim4 = Cells(cnt, 9)
dim5 = Cells(cnt, 10)
dim6 = Cells(cnt, 11)
dim7 = Cells(cnt, 12)
dim8 = Cells(cnt, 13)
strSQL = strSQL & "INSERT EXP_LedgerJournalTrans" & _
"(State,ParentRecId,TableRecNo,TransDate,AccountNum,OffsetAccount," & _
"AmountCurDebit,Txt," & _
"Dimension,Dimension2_,Dimension3_,Dimension4_," & _
"Dimension5_,Dimension6_,Dimension7_,Dimension8_)" & Chr$(10) & Chr$(12)
strSQL = strSQL & "VALUES (0,'0'," & cnt & ",'" & _
transDate1 & "','" & accountNum1 & "','" & offsetAccount1 & "'," & _
amountCurDebit1 & ",'" & txt1 & "','" & _
dim1 & "','" & dim2 & "','" & dim3 & "','" & dim4 & "','" & _
dim5 & "','" & dim6 & "','" & dim7 & "','" & dim8 & "')" & Chr$(10) & Chr$(12)
cnt = cnt + 1
Loop While cnt <= miRow
strSQL = strSQL & "UPDATE EXP_LedgerJournalTrans" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SET TableRecNo=RecNo" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE ParentRecId='0'" & Chr$(10) & Chr$(12)
strSQL = strSQL & "UPDATE EXP_LedgerJournalTrans" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SET ParentRecId=(SELECT CAST(RecNo AS Varchar(20)) from EXP_LedgerJournalTable" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE State=0 AND" & Chr$(10) & Chr$(12)
strSQL = strSQL & "SystemID='" & systemID1 & "' AND" & Chr$(10) & Chr$(12)
strSQL = strSQL & "Name='" & name1 & "')" & Chr$(10) & Chr$(12)
strSQL = strSQL & "WHERE ParentRecID='0'" & Chr$(10) & Chr$(12)
strSQL = strSQL & "COMMIT TRANSACTION" & Chr$(10) & Chr$(12)
Set wrkPbd = CreateWorkspace("", mUID, mPWD, dbUseODBC)
Set dbsPbd = wrkPbd.OpenDatabase("", , False, "ODBC;DSN=" & mDSN) dbsPbd.Execute strSQL
dbsPbd.Close
End Sub