所以我的主要问题是我有一个代码来使用SSO打开SAP和SAP窗口,执行SAP脚本,将报告导出为Excel表格(此后它会自动打开excel),然后关闭导出的Excel -片。在调试器中逐步执行时,代码工作得很好。当我以正常模式处理代码时,脚本完成后它将停止,并且excel应该打开(在调用CloseExcel函数之前)。如果您可以看一下我的代码并提供我所缺少的一些知识,那将是很好的。我很感谢每一个提示。
我已经用wscript.sleep和application.wait命令对其进行了测试。我也尝试拆分宏,但似乎没有任何效果。
Option Explicit
'here are some public variables which i use in more than one sub
Dim W_System
Public SapGuiAuto, WScript, msgcol
Public objGui As GuiApplication
Public objConn As GuiConnection
Public objSess As GuiSession
Public objSBar As GuiStatusbar
Public objSheet As Worksheet
Dim Path$, Dataname$
'Here I run all macros at once (later I want to run everything with a button)
Sub Execute()
'My SAP System SYSID "HE5", Mandant "100"
W_System = "HE5100"
SAP1
application.Wait (Now + TimeValue("00:00:05"))
SAP2
objSess.EndTransaction
End Sub
Sub SAP1()
'Here are some variables i need in this code
Dim WSHShell As Object
Dim WScript, SAPGUIPath, Instanz, WinTitel, SapGuiAuto, application, connection, session, Name
On Error Resume Next
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
If Err.Number <> 0 Then
Set WSHShell = CreateObject("WScript.Shell")
If IsObject(WSHShell) Then
'Here I open the SAP and a SAP window
SAPGUIPath = "C:\Program Files (x86)\SAP\FrontEnd\SAPgui\"
Name = """Enterprise PROD SYSS"""
Instanz = "00"
WSHShell.Exec SAPGUIPath & "sapgui.exe " & Name & " " & _
Instanz
Set WSHShell = Nothing
End If
On Error GoTo 0
Else
On Error GoTo 0
End If
End If
On Error Resume Next
If Not IsObject(connection) Then
Set connection = application.Children(0)
If Err.Number <> 0 Then
'msgbox open another SAP window
Else
On Error GoTo 0
End If
Set connection = application.Children(0)
End If
End Sub
'With this function I connect to the SAP window so I can execute the Script
Function Attach_Session() As Boolean
Dim il, it
Dim W_conn, W_Sess
If W_System = "" Then
Attach_Session = False
Exit Function
End If
If Not objSess Is Nothing Then
If objSess.Info.SystemName & objSess.Info.Client = W_System Then
Attach_Session = True
Exit Function
End If
End If
If objGui Is Nothing Then
Set SapGuiAuto = GetObject("SAPGUI")
Set objGui = SapGuiAuto.GetScriptingEngine
End If
For il = 0 To objGui.Children.Count - 1
Set W_conn = objGui.Children(il + 0)
For it = 0 To W_conn.Children.Count - 1
Set W_Sess = W_conn.Children(it + 0)
If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
Set objConn = objGui.Children(il + 0)
Set objSess = objConn.Children(it + 0)
Exit For
End If
Next
Next
If objSess Is Nothing Then
MsgBox "No active session to system " + W_System + ", or scripting is not enabled.", vbCritical + vbOKOnly
Attach_Session = False
Exit Function
End If
If IsObject(WScript) Then
WScript.ConnectObject objSess, "on"
WScript.ConnectObject objGui, "on"
End If
Set objSBar = objSess.findById("wnd[0]/sbar")
objSess.findById("wnd[0]").maximize
Attach_Session = True
End Function
Sub SAP2()
Dim W_Ret As Boolean
Dim actualdate As Date
Dim Version As Byte
' Connect to SAP
W_Ret = Attach_Session
If Not W_Ret Then
Exit Sub
End If
'Get variables for the script
Worksheets("Parameter").Activate
actualdate = Cells(1, 2)
Version = Cells(3, 2)
Path = Cells(5, 2)
Dataname = Cells(6, 2)
On Error GoTo myerr
'Insert SCRIPT HERE
With objSess
.findById("wnd[0]").maximize
.findById("wnd[0]/tbar[0]/okcd").Text = "s_alr"
.findById("wnd[0]").SendVKey 0
.findById("wnd[0]/tbar[1]/btn[17]").press
.findById("wnd[0]/usr/ctxtBERDATUM").Text = actualdate
.findById("wnd[0]/usr/ctxtBEREICH1").Text = Version
.findById("wnd[0]/usr/ctxtBEREICH1").SetFocus
.findById("wnd[0]/usr/ctxtBEREICH1").caretPosition = 2
.findById("wnd[0]/tbar[1]/btn[8]").press
.findById("wnd[0]/tbar[1]/btn[33]").press
.findById("wnd[1]/usr/lbl[1,7]").SetFocus
.findById("wnd[1]/usr/lbl[1,7]").caretPosition = 7
.findById("wnd[1]").SendVKey 2
.findById("wnd[1]/tbar[0]/btn[0]").press
.findById("wnd[0]/mbar/menu[0]/menu[1]/menu[1]").Select
.findById("wnd[1]/tbar[0]/btn[0]").press
.findById("wnd[1]/usr/ctxtDY_PATH").Text = Path
.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = Dataname & ".xlsx"
.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 9
.findById("wnd[1]/tbar[0]/btn[11]").press
End With
'I found this function from a different thread but it seems it doesnt work for me in normal mode
Call CloseExcel(Dataname & ".xlsx")
Exit Sub
myerr:
MsgBox "Error occured while retrieving data", vbCritical + vbOKOnly
End Sub
Sub CloseExcel(Optional ByVal archiv As String)
Dim wshell
Dim xclapp, xclsheet, xclwbk
On Error Resume Next
Set wshell = CreateObject("WScript.Shell")
Do
Err.Clear
Set xclapp = GetObject(, "Excel.Application")
If Err.Number = 0 Then Exit Do
DoEvents
WScript.sleep 2000
Loop
Do
Err.Clear
Set xclwbk = xclapp.Workbooks.Item(archiv)
If Err.Number = 0 Then Exit Do
DoEvents
WScript.sleep 2000
Loop
On Error GoTo 0
Set xclsheet = xclwbk.Worksheets(1)
xclapp.Visible = True
xclapp.DisplayAlerts = False
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
End Sub
作为输出,我希望通过普通模式运行宏,并在最后关闭excel工作表。此刻脚本之后停止(没有错误消息,在按export excel按钮后,该脚本仍在运行,但没有任何结果,并且excel宏挂断了。)