tenho a solução pra vc
Option Explicit
Public SAP As Object
Public SAPGUI As Object
Public SAPCon As Object
Public SAPSession As Object
'run saplogon if it is not running
Sub OpenSAP()
Dim SAPTaskID As Double
Dim SAPLogonPad As String
SAPLogonPad = "C:Program Files (x86)SAPFrontEndSAPguisaplogon.exe"
'C:Program Files (x86)SAPFrontEndSAPguisaplogon.exe
On Error Resume Next
AppActivate "SAP Logon 730"
If Err <> 0 Then
Err = 0
SAPTaskID = Shell(SAPLogonPad, vbNormalFocus)
If Err <> 0 Then
'MsgBox "Cannot start SAPLOGON", vbCritical, "SAPLOGON FAILED"
Else
'MsgBox "SAP Logon activated " & SAPTaskID, vbInformation, "SAP Running"
End If
End If
End Sub
Sub SAPLogon()
Call OpenSAP
Dim emp As Object
Dim cn_server As ADODB.Connection
Dim TABELAGeral As ADODB.Recordset
Dim sSQL
Set emp = New conectar_banco
Set cn_server = New ADODB.Connection
cn_server.Open emp.conectar_banco
'AppActivate (ThisWorkbook.name)
Static sapID As String
Static sapPassword As String
If sapID = "" Or sapPassword = "" Then
'With loginSAP 'a userform to get the sap id and password
'.Show
'sapID = .SAPuser
'sapPassword = .SAPPass
'End With
End If
Dim timme As Date
timme = Now + CDate("00:00:05")
Do While Now < timme
Loop
If SAPGUI Is Nothing Then
Set SAP = GetObject("sapgui")
Set SAPGUI = SAP.GetScriptingEngine
End If
If SAPCon Is Nothing Then
'142.40.81.34
'dbciEP0.sap.valeglobal.net
'On Error Resume Next
Set SAPCon = SAPGUI.OpenConnectionByConnectionString("dbciEP0.sap.valeglobal.net")
' Set SAPCon = SAPGUI.OpenConnectionByConnectionString("/H/dbciEP0.sap.valeglobal.net/S/3200", True)
'SendKeys "{ENTER}"
'SAPActive.SapConnection = SAPActive.SapGuiApp.OpenConnection(connectString, Sync: true);
Else
'(what should I put here to call the SAPCon object already declared from previous run?)
End If
If SAPSession Is Nothing Then
Set SAPSession = SAPCon.Children(0)
With SAPSession
sSQL = "select * FROM [BD_GAREG].[dbo].[senha_unilog];"
Set TABELAGeral = New ADODB.Recordset
TABELAGeral.Open sSQL, cn_server
.findById("wnd[0]/usr/txtRSYST-MANDT").Text = "500"
.findById("wnd[0]/usr/txtRSYST-BNAME").Text = TABELAGeral("id")
.findById("wnd[0]/usr/pwdRSYST-BCODE").Text = TABELAGeral("senha")
cn_server.Close
.findById("wnd[0]/usr/txtRSYST-LANGU").Text = "PT"
.findById("wnd[0]").sendVKey 0
End With
AT_BASE_BASE
Else
'(how do I call the Session already running from previous call to this script?)
End If
End Sub
Sub AT_BASE_BASE()
Dim SapGuiApp As Object
Dim oConnection As Object
Dim Session As Object
Dim SAPCon As Object, SAPSesi As Object
Dim SAPGUIAuto As Object, SAPApp As Object
Dim NumOfRows As Long
Dim Counter As Long
Dim SAP As Object, SAPGUI As Object, SAPConnections As Object
Dim cntConnection As Long, i As Long, SAPConnection As Object
Dim Sessions As Object, cntSession As Long, j As Long
Dim SessionExists As Boolean
Application.ScreenUpdating = False
NumOfRows = ActiveSheet.UsedRange.Rows.Count - 3
SessionExists = False
On Error Resume Next
Set SAP = GetObject("SAPGUI")
If Not IsObject(SAP) Then
Exit Sub
End If
Set SAPGUI = SAP.GetScriptingEngine
If Not IsObject(SAPGUI) Then
Exit Sub
End If
Set SAPConnections = SAPGUI.Connections()
If Not IsObject(SAPConnections) Then
Exit Sub
End If
cntConnection = SAPConnections.Count()
For i = 0 To cntConnection - 1
Set SAPConnection = SAPGUI.Connections(CLng(i))
If IsObject(SAPConnection) Then
Set Sessions = SAPConnection.Sessions()
If IsObject(Sessions) Then
cntSession = Sessions.Count()
For j = 0 To cntSession - 1
Set Session = SAPConnection.Sessions(CLng(j))
If IsObject(Session) Then
SessionExists = True
End If
Next j
End If
End If
Next i
If SAPConnection Is Nothing Then
SAPLogon
' MsgBox "Error.. no SAP session could be found"
Exit Sub
Else
Dim emp As Object
Dim cn_server As ADODB.Connection
Dim TABELAGeral As ADODB.Recordset
Dim sSQL
Set emp = New conectar_banco
Set cn_server = New ADODB.Connection
cn_server.Open emp.conectar_banco
sSQL = "select * FROM [BD_GAREG].[dbo].[senha_unilog];"
Set TABELAGeral = New ADODB.Recordset
TABELAGeral.Open sSQL, cn_server
With Session
.findById("wnd[0]").maximize 'Last available sessions is maximized
.findById("wnd[0]/usr/txtRSYST-BNAME").Text = TABELAGeral("id")
.findById("wnd[0]/usr/pwdRSYST-BCODE").Text = TABELAGeral("senha")
.findById("wnd[0]/usr/pwdRSYST-BCODE").SetFocus
.findById("wnd[0]/usr/pwdRSYST-BCODE").caretPosition = 8
.findById("wnd[0]").sendVKey 0
End With
cn_server.Close
End If
With Session
.findById("wnd[0]/mbar/menu[1]/menu[10]").Select
End With
With Session
.findById("wnd[0]/tbar[0]/okcd").Text = "IW39"
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/btn%_GEWRK_%_APP_%-VALU_PUSH").press
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,0]").Text = "LQ01*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").Text = "LM00*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,2]").Text = "ROD0*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,3]").Text = "REVI*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,4]").Text = "REPE*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,5]").Text = "CML01*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,6]").Text = "CEL01*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,6]").Text = "TRUK*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,6]").Text = "GAF*"
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").SetFocus
.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").caretPosition = 5
.findById("wnd[1]/tbar[0]/btn[0]").press
.findById("wnd[1]/tbar[0]/btn[8]").press
.findById("wnd[0]/usr/txtVAWRK-LOW").Text = "4065"
.findById("wnd[0]/usr/txtVAWRK-LOW").SetFocus
.findById("wnd[0]/usr/txtVAWRK-LOW").caretPosition = 4
'.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ctxtDATUV").Text = ""
.findById("wnd[0]/usr/ctxtDATUV").SetFocus
.findById("wnd[0]/usr/ctxtDATUV").caretPosition = 0
'.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ctxtDATUB").Text = ""
.findById("wnd[0]/usr/ctxtDATUB").SetFocus
.findById("wnd[0]/usr/ctxtDATUB").caretPosition = 0
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/tbar[1]/btn[8]").press
.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").setCurrentCell -1, ""
.findById("wnd[0]/usr/cntlGRID1/shellcont/shell").SelectAll
.findById("wnd[0]/mbar/menu[0]/menu[11]/menu[2]").Select
.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").Select
.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").SetFocus
.findById("wnd[1]/tbar[0]/btn[0]").press
'.findById("wnd[1]/tbar[0]/btn[0]").press
End With
ClipBoardToSQL
End Sub
Public Function ContaCaracteresNaString(ByVal texto As String, ByVal caracter As String) As Long
Dim x As Variant
x = Split(texto, caracter)
ContaCaracteresNaString = UBound(x)
End Function
Sub ClipBoardToSQL()
Dim objData As New MSForms.DataObject
Dim strText
Dim rsNew, SalRec2, rs2 As ADODB.Recordset
Dim conn As ADODB.Connection
Dim rec As New DataObject
Dim MyArray22 As Integer
Dim db As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim rec2 As Database
Dim linn As Integer
MyArray22 = 445
Dim mtz(10000, 40) As Variant
objData.GetFromClipboard
strText = objData.GetText()
strText = Replace(strText, Left(strText, InStr(strText, "-" & vbNewLine & "|")), "") 'Chr(10)=
strText = Replace(strText, "Fim real ", "Fim_real_date"): strText = Replace(strText, "Fim real", "Fim_real_hora")
strText = Replace(strText, "-", ""): strText = Replace(strText, "CenTrab respon.", "CenTrab_respon")
strText = Replace(strText, "Campo sel.", "ativo"): strText = Replace(strText, "Pln.manut.", "Pln_manut")
strText = Replace(strText, "Ordem", "Ordem_manutencao"): strText = Replace(strText, "Tp.", "Tipo")
strText = Replace(strText, "Cen.", "Centro"): strText = Replace(strText, "StatUsuár.", "Status usuário")
strText = Replace(strText, "Status usuário", "Status usuário")
strText = Replace(strText, "Data entr.", "dat_entrada"): strText = Replace(strText, "Status do sistema.", "status_sistema")
strText = Replace(strText, "Fim-base", "Fim_base")
strText = Replace(strText, "Iníc.real", "inicio_real")
strText = Replace(strText, "InícReal", "InicReal")
strText = Replace(strText, "CustTotPl.", "CustTotPl")
strText = Replace(strText, "CustTotRe.", "CustTotRe")
strText = Replace(strText, "-", ""): strText = Replace(strText, "-", "")
' strText = Replace(strText, "-", ""): strText = Replace(strText, "X ", "")
'MsgBox ContaCaracteresNaString(strText, "|")
' Replace(strText, "|", " ")
' MsgBox strText
If InStr(strText, "|") = 0 Then Exit Sub
'~~> Divide strText, delimitador vbNewLine
strArray = Split(strText, vbNewLine)
lin = 1
mtz(0, 0) = strArray(1) 'Títulos
linn = ContaCaracteresNaString(mtz(0, 0), "|")
'MsgBox UBound(mtz, 2)
For lin = 1 To UBound(strArray, 1) - 1
For col = 1 To UBound(mtz, 2)
On Error Resume Next
'If Len(strArray) > 10 Then
mtz(lin, col) = Trim(Split(strArray(lin), "|")(col))
' End If
Next col
Next lin
MsgBox mtz
Set rsNew = ADOCopyArrayIntoRecordset(argArray:=mtz)
End Sub
Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As ADODB.Recordset
Dim rsADO As ADODB.Recordset
Dim lngR As Long
Dim lngC As Long
Set rsADO = New ADODB.Recordset
For lngC = 1 To UBound(argArray, 2) 'Column
rsADO.Fields.Append IIf(argArray(0, lngC) = "", "Col" & lngC, argArray(0, lngC)), adVariant
Next lngC
rsADO.Open
For lngR = 1 To UBound(argArray, 1) 'Row
rsADO.AddNew
For lngC = 1 To UBound(argArray, 2) 'Column
rsADO.Fields(lngC - 1).Value = Replace(argArray(lngR, lngC), Chr(39), "`") '+Substituir aspas simples por grave
Next lngC
rsADO.MoveNext
Next lngR
rsADO.MoveFirst
Plan6.Range("A1:xfd1048576").Clear
Worksheets("SAP_BASE").Range("A1").CopyFromRecordset rsADO
Set ADOCopyArrayIntoRecordset = rsADO
'fluxo_valor = rsADO!Ordem
End Function
Public Property Get conectar_banco() As String
conectar_banco = "Driver={SQL Server};Server=172.20.15.130;uid=FMDS;pwd=@rzatdamf@"
'conectar_banco = "Driver={SQL Server};Server=BR9250042;uid=FMDS;pwd=@rzatdamf@"
' conectar_banco = "Provider=SQLNCLI10;Server=nome do server;User ID=id;Password=senha;"
'172.20.15.130
'BR9250042
'BR9250042
End Property
Postado : 26/10/2015 8:55 pm