Thank
Sub main()
Dim cData As Date
Dim str_dta_proc As String
Dim str_cmd01 As String
Dim str_cmd02 As String
Dim str_cmd03 As String
'--------
Dim cDtaPagto As String
Dim bTransacao As Boolean
On Error GoTo TrataErro
Set functionCtrl = CreateObject("SAP.Functions")
Set sapConnection = functionCtrl.Connection
'-------------------------------
' Conecta no SAP
'-------------------------------
bTranscaco = False
With sapConnection
.Client = "230"
.user = "TARANDER"
.password = "ftr7kr1$"
.ApplicationServer = "10.175.12.100"
.Language = "EN"
.TraceLevel = 0
.codepage = "8600"
End With
'-----------------------------
' Testa Login
'----------------------------
If sapConnection.Logon(0, True) <> True Then
MsgBox "No connection to R/3 System"
Exit Sub
End If
Set theFunc = functionCtrl.Add("ZFORI_WEB_PGTO_PARCEIROS")
theFunc.exports("I_LIFNR") = "0001064425"
'theFunc.exports("I_DATAINICIO") = "01012005"
'theFunc.exports("I_DATAFIM") = "31122012"
Set objtblparceiro = theFunc.tables("T_PAGTO_PARCEIRO")
If theFunc.Call = False Then
MsgBox "Error occured - " & objRfcFunc.Exception
End If
'Debug.Print objtblparceiro.RowCount
'Debug.Print objtblparceiro("CODIGOMATERIAL")
Dim ITAB As Object
Dim i As Integer
Set ITAB = theFunc.tables.Item("T_PAGTO_PARCEIRO")
'Open App.Path & "\TB_PAGTO_PARCEIRO.TXT" For Input As #1
'Open App.Path & "\ARPARCEIRO.CTL" For Output As #2
Conecta_Banco
cData = Now()
cn.BeginTrans
bTransacao = True
str_dta_proc = Format(cData, "dd/mm/yyyy HH:mm:ss")
str_cmd01 = "INSERT INTO OSINBUNGE.TB_PAGTO_PARCEIRO ( " & vbCrLf
str_cmd01 = str_cmd01 & " CODIGOFORNECEDOR, CODIGOCONTRATOSAP, CODIGOMATERIAL, " & vbCrLf
str_cmd01 = str_cmd01 & " DESCMATERIAL, SAFRA, TIPODOCUMENTO," & vbCrLf
str_cmd01 = str_cmd01 & " DOCUMENTOREFERENCIA, DATAPAGAMENTO, MOEDA," & vbCrLf
str_cmd01 = str_cmd01 & " VALOR, COTACAOMOEDA, BANCO," & vbCrLf
str_cmd01 = str_cmd01 & " AGENCIA, CONTACORRENTE, FAVORECIDO," & vbCrLf
str_cmd01 = str_cmd01 & " REFERENCIADOCPARCEIRO, SITUACAOPAGAMENTO, " & vbCrLf
str_cmd01 = str_cmd01 & " DATA_PROCESSAMENTO)" & vbCrLf
str_cmd01 = str_cmd01 & " VALUES ( " & vbCrLf
For i = 1 To ITAB.RowCount
If Len(Trim(ITAB(i, "DATAPAGAMENTO"))) = 0 Then
cDtaPagto = ""
Else
cDtaPagto = "to_date (" & Chr(39) & ITAB(i, "DATAPAGAMENTO") & Chr(39) & ",'DD/MM/YYYY HH24:MI:SS')"
End If
str_cmd02 = Chr(39) & ITAB(i, "CODIGOFORNECEDOR") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "CODIGOCONTRATOSAP") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "CODIGOMATERIAL") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "DESCMATERIAL") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & ITAB(i, "SAFRA") & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "TIPODOCUMENTO") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "DOCUMENTOREFERENCIA") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & cDtaPagto & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "MOEDA") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Replace(ITAB(i, "VALOR"), ",", ".") & "," & vbCrLf
str_cmd02 = str_cmd02 & Replace(ITAB(i, "COTACAOMOEDA"), ",", ".") & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "BANCO") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "AGENCIA") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "CONTACORRENTE") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "FAVORECIDO") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "REFERENCIADOCPARCEIRO") & Chr(39) & "," & vbCrLf
str_cmd02 = str_cmd02 & Chr(39) & ITAB(i, "SITUACAOPAGAMENTO") & Chr(39) & "," & "TO_DATE (" & Chr(39) & str_dta_proc & Chr(39) & ",'dd/mm/yyyy hh24:mi:ss')" & ")"
str_cmd03 = str_cmd01 & str_cmd02
Debug.Print str_cmd03
cn.Execute str_cmd03
Next i
cn.CommitTrans
MsgBox "processamento realizado com sucesso"
'*-----------------------------------------------------------------------'
'FUNCTION zfori_web_pgto_parceiros.
'*"----------------------------------------------------------------------
'*"*"Interface local:
'*" IMPORTING
'*" VALUE(I_LIFNR) TYPE LIFNR
'*" VALUE(I_DATAINICIO) TYPE DATE OPTIONAL
'*" VALUE(I_DATAFIM) TYPE DATE OPTIONAL
'*" TABLES
'*" T_PAGTO_PARCEIRO STRUCTURE ZSTORI_PAGTO_PARCEIRO_WEB
'*"----------------------------------------------------------------------
TrataErro:
If bTransacao Then
cn.RollbackTrans
cn.Close
End If
MsgBox Err.Description
End Sub
Bluesky
