I am trying to write a macro that retrieves data from an ALV grid in SAP GUI. Everything is working fine up until the data exports. When exporting data from ALV grid to an .xlsx file, the file will automatically open after it exports.
I need my script to wait for the export to open, and then copy the data from the newly opened export file to the .xlsm file that the script is coming from.
If I try to activate the export.XLSX file immediately following the command to export the file in SAP GUI, I get a "subscript out of range" error. I thought maybe I could loop the activate command until it stops erroring (while the export.xlsx file is opening) but that causes excel to crash. What should I do?
Function funcLSAT(strEnv)
Dim wkbExport As Workbook
Dim strError As String
If Not IsObject(SapGuiApp) Then
Set SapGuiApp = CreateObject("Sapgui.ScriptingCtrl.1")
End If
If Not IsObject(Connection) Then
Set Connection = SapGuiApp.OpenConnection(strEnv, True)
End If
Set session = Connection.Children(0)
session.findById("wnd[0]/tbar[0]/okcd").Text = "[TCODE]"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/usr/cntlG_CC_MCOUNTY/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/cntlG_CC_MCOUNTY/shellcont/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/ctxtDY_PATH").Text = "[filepath]"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "export.xlsx"
session.findById("wnd[1]/tbar[0]/btn[11]").press
Set session = Nothing
Set Connection = Nothing
Set SapGuiApp = Nothing
Do
On Error Resume Next
Windows("export.XLSX").Activate
Loop Until (Err.Number = 0)
On Error GoTo 0
Range("A2:AS2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End Function
I had the same issue time ago when my macro had to wait for a .txt to be created and then continue so I found this:
Dim Directory As String, File As String
Directory = ActiveWorkbook.Path & "\" 'path for the file
File = Directory & "datos.txt" 'name of the file along with the path
FindIt = Dir(File)
While Len(FindIt) = 0
FindIt = Dir(File)
Wend
Hope it helps.
Here is what I do to export as XSLX, copy over the sheet, and close.
Application.wait does not do what you would want it to do here. Application.wait does not release Excel and so the SAP file never opens. Setting a timer will release Excel so the file will load.
It may not be the most well written, but it works. First, do a function to be able to see if the files are open or not. Then, set a timer of 0.5 seconds or so to put on a loop. You could do a longer timer and probably wouldn't have to loop, but done with a short time keeps Excel from being released any longer than it has to. Once the file locked on to, it will copy over the contents and close the file, and will exit the loop. Then I also kill the file because, on next run, it needs to be gone if the first run the isfile open is going to pick up the old file. This is written to where it's supposed to grab the workbook if it's opened in another instance—though, I haven't tested that. The way my VBA workbook loads, SAP files end up loading in the same instance. Good Luck!
Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select
End Function
Dim xlfile as string, xldir as string
Dim PauseTime, Start
Dim control As Long
Dim xlapp As Object
Dim wb as workbook
xldir= "Your file folder path here"
control = 0
xlfile = "Your filename here"
Do Until control = 5
PauseTime = 0.5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
If control = 1 And IsFileOpen(xldir & xlfile) = False Then
Exit Do
End If
If IsFileOpen(xldir & xlfile) = True Then
Set xlapp = GetObject(xldir & xlfile).Application
If control = 0 Then
Workbooks(xlfile).Sheets(1).Name = Left(xlfile, Len(xlfile) - 5)
Workbooks(xlfile).Sheets(Left(xlfile, Len(xlfile) - 5)).Copy
before:=ThisWorkbook.Sheets(1)
ThisWorkbook.Activate
control = 1
End If
For Each wb In Application.Workbooks
If wb.Name = xlfile Then
wb.Close
End If
Next wb
End If
Loop
control = 0
kill(xldir&xlfile)
Related
I am using an interface made with Excel to allow users to concurrently edit a shared data file. To prevent multiple users from editing at the same time I made the following function to do the following:
Open the file
If the file was opened as a read-only, close the file and re-open until the file is opened as read-write or the maximum number of allowed attempts is crossed.
Function OpenTillCanEditC(refpath As String, pw As String) As Workbook
Dim wbtoopen As Workbook
Dim maxOpen As Long
Dim i As Long
Dim buttonClicked As Long
maxOpen = 10
i = 0
On Error GoTo ErrHandler:
Application.DisplayAlerts = False
Set wbtoopen = Workbooks.Open(refpath, True, Password:=pw, ReadOnly:=False)
Application.DisplayAlerts = True
While wbtoopen.ReadOnly And i < maxOpen
If wbtoopen.ReadOnly Then
wbtoopen.Close (False)
Application.Wait (Now + TimeValue("00:00:01"))
Set wbtoopen = Nothing
i = i + 1
If i >= maxOpen Then
buttonClicked = MsgBox("It appears the masterlist is currently being used by someone else. Do you want to retry opening?", vbRetryCancel)
If buttonClicked = vbRetry Then
maxOpen = maxOpen + 10
Application.DisplayAlerts = False
Set wbtoopen = Workbooks.Open(refpath, True, Password:=pw, ReadOnly:=False)
Application.DisplayAlerts = True
End If
Else
On Error GoTo ErrHandler:
Application.DisplayAlerts = False
Set wbtoopen = Workbooks.Open(refpath, True, Password:=pw, ReadOnly:=False)
Application.DisplayAlerts = True
End If
End If
Wend
Set OpenTillCanEditC = wbtoopen
Exit Function
ErrHandler:
Application.DisplayAlerts = True
If Err.Number = 1004 Then
MsgBox "The password keyed in is wrong."
Else
MsgBox "The masterlist found in " & refpath & " cannot be opened. It may be used by someone else or corrupted. If corrupted please open the file manually using Excel."
End If
Set wbtoopen = Nothing
Set OpenTillCanEditC = wbtoopen
End Function
OpenTillCanEditC will be used in a sub for updating as shown below:
Sub UpdateFile()
'Try to open
Dim datawb As Workbook
Dim filepath As String
Dim pw As String
filepath = "C:\Folder Containing File\Data File.xlsx"
pw = "password"
Set datawb = OpenTillCanEditC(filepath, pw)
If datawb Is Nothing Then
MsgBox "File cannot be opened or is currently in use."
Exit Sub
End If
'Do functions needed in the workbook here
datawb.Save()
datawb.Close
End Sub
However I keep getting either of the following two errors:
When multiple people are attempting to access the file, the OpenTillCanEditC function will still ask for a password even though it is already being keyed in.
datawb.Save() will sometimes throw an error stating that the save failed due to multiple users accessing the file.
How do I fix both of these issues to allow multiple users to edit a shared password-protected file using VBA?
I used some code from Close an opened PDF after opening it using FollowHyperlink to create the following code to open a pdf file and rename it. The code runs fine but only if I break execution at MsgBox "Break Here" and step into it with the F8 key. Any ideas on why it won't execute automatically?
Sub OpenPDF()
'Opens PDF Scaned file & saves it to another folder
'***ErrorHandler***
On Error Resume Next
'***Declare Objects****
Dim objectWMI As Object
Dim objectProcess As Object
Dim objectProcesses As Object
Dim Path As String
Dim MyDir As String
'***Opens a new workbook if there are no active workbooks***
'***There must be an active workbook for FollowHyperlink to function***
nowbs = Application.Workbooks.Count
If nowbs = 1 Then
Application.Workbooks.Add
Else
End If
'***Saves current Excel path
MyDir = CurDir
'***Sets path to Ricoh Scans
PDFDir = "S:\Ricoh Scans"
ChDir PDFDir
'***Gets filename for PDF scan
Path = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
'***Opens PDF file***
ActiveWorkbook.FollowHyperlink Path
'***Sets Excel as active application
AppActivate "Microsoft Excel"
'***Prompts for PO number****
MyPONum = InputBox("Enter PO Number", "PO Editor", "30500")
'***If user selects Cancel on inputbox then xl closes Acrobat and exits sub
If MyPONum = vbNullString Then
GoTo EndAll
Else
End If
'***Replaces scanned filename with inputbox filename
PathLen = Len(Path)
OldName = Mid(Path, 16, PathLen - 19)
NewName = "S:\Materials Management\Purchase Orders\PO " & MyPONum & ".pdf"
EndAll:
'***Set Objects***
Set objectWMI = GetObject("winmgmts://.")
Set objectProcesses = objectWMI.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Acrobat.exe'") '< Change if you need be ** Was AcroRd32.exe**
'
'
'Code executes fine up to here but must Ctrl + Break at this line
'and F8 step thru balance of code or it will not work
'
'
MsgBox "Break Here"
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
Call objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub
Thanks to all for your input. I'm not a programmer and as I said I used code that had been posted elsewhere on this site. It was a timing issue and this edit works.
'***Terminate all Open PDFs***
For Each objectProcess In objectProcesses
objectProcess.Terminate
Next
'***Clean Up***
Set objectProcesses = Nothing
Set objectWMI = Nothing
'***************
Application.Wait (Now + TimeValue("00:00:02"))
'***Renames scanned file and moves it to Materials Management folder***
Name Path As NewName
'***Resets current directory
ChDir MyDir
End Sub
I have a Macro which reads data from another Excel file. If the file is already opened by the user Excel tries to reopen the file - this is fine so far.
However if the file is opened in Protected View then the macro stops at this line:
Workbooks.Open Filename:=Sheets("Control Sheet").Range("C6").value
With the Error:
Run-time error '1004' This file is already open in Protected View
How can I fix this?
For reading I recommend Scott Holtzman's solution:
Workbooks.Open Filename:="FileName", ReadOnly:=True
For other cases you can remove the protected mode by:
Do While Application.ProtectedViewWindows.Count > 0
Application.ProtectedViewWindows(1).Edit
Loop
Application.OnTime works fine if there is no open workbook, but not if the apparently active workbook is in protected view (since a protected view window can't be the active window).
One solution is to programmatically enable editing in any protected view windows, but that's bad security practice.
Instead of this, I do a little test, and if it seems that a protected view window is in front, I create a new window temporarily, run the Application.OnTime, then close the temporary workbook.
' Fix: OnTime fails if "active" window is protected view
If Application.Windows.Count > 0 And ActiveWindow Is Nothing Then
Dim bTempWkbk As Boolean
bTempWkbk = True
Dim wb As Workbook
Set wb = Workbooks.Add
End If
Application.OnTime Now + TimeValue("0:00:02"), "OnTimeFunction"
If bTempWkbk Then
wb.Close False
End If
I had the same issue. This worked for me:
Sub ActivateProtectedWorkbook(fileName As String)
Dim wbProtected As Workbook
If Application.ProtectedViewWindows.Count > 0 Then
For i = 1 To Application.ProtectedViewWindows.Count
If Application.ProtectedViewWindows(i).Workbook.Name = fileName Then
Set wbProtected = Application.ProtectedViewWindows(i).Workbook
End If
Next
End If
wbProtected.Activate
End Sub
fileName mustn't include the full path. This may not work if the file isn't opened already and you run into another error due to a corrupted file or something.
In case you need to remove the full path from the fileName, use this:
Function RemoveFilePath(fileName As String) As String
'This sub removes the full path from fileName leaving only the file's name.
'e.g. C:\Users\Toshiba\Documents\Worksheet Consulting\John\7.28\Hobson - Copy.xlsx
' --> Hobson - Copy.xlsx
myStr = fileName
Do
myInt = InStr(1, myStr, "\")
myStr = Right(myStr, Len(myStr) - myInt)
Loop Until InStr(1, myStr, "\") = 0
RemoveFilePath = myStr
End Function
You can call the code as such:
On Error GoTo Activate
Set tempWorkBook = Workbooks.Open(fileName, , True)
GoTo WasClosed
Activate:
noPath = RemoveFilePath(fileName)
Call ActivateProtectedWorkbook(noPath)
WasClosed:
On Error GoTo 0
Using VBA Access
Is there a more efficient way of making an open read only excel file to read/write mode?
Or check if read only is true wait till read/write is active
I created a continuous loop that opens and closes the file till read/write is active. However sometimes it works sometimes it doesn't, frustrating.
I've looked into toggling read/write also Changefileaccess even SETATTR functions
Dim xl As Object
Set xl = CreateObject("Excel.Application")
Do Until xl.ActiveWorkbook.ReadOnly = False
xl.Quit
xl.Workbooks.Open ("C:\TEST\Test.xlsb")
If xl.ActiveWorkbook.ReadOnly = False Then Exit Do
Loop
Few observations:
There is a possibility that your code can go into an endless loop. Give some wait time before you recheck again.
Define the number of times the code should attempt re-opening.
Don't use CreateObject. CreateObject creates a new applicaiton. Use GetObject if you want to work with the already open file.
Check if the attribute is read only before you re-open the file.
See this example (Untested)
Sub Sample()
Dim objxlAp As Object, objxlWb As Object
Dim FlName As String
Dim NumberOfAttempt As Long
FlName = "C:\TEST\Test.xlsb"
Set objxlAp = GetObject(, "Excel.Application")
Set objxlWb = objxlAp.ActiveWorkbook
Do Until objxlWb.ReadOnly = False
objxlWb.Close (False)
If GetAttr(FlName) = vbReadOnly Then _
SetAttr FlName, vbNormal
objxlAp.Workbooks.Open (FlName)
If objxlWb.ReadOnly = False Then Exit Do
Wait 60 '<~~ Wait for 60 seconds. Change as Applicable
NumberOfAttempt = NumberOfAttempt + 1
If NumberOfAttempt > 5 Then
MsgBox "Tried reopening the file 5 times. Unable to do it. Exiting the loop"
Exit Do
End If
Loop
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Important Note: A workbook can me made Read-Only using these two means
Right click on the file and set attribute as ReadOnly
File Save As - Read Only Recommended. The above code is not for this method.
My Assumptions:
You are not on a network where the file has been opened by a different user.
Can you check using GetAttr:
If ((GetAttr("C:\tmp\Test.xlsb")) And vbReadOnly) Then
Debug.Print "Do something, file is read only"
End If
Maybe change this property before open file?
Sub OpenRW()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\tmp\Test.xlsb")
Debug.Print "1. ReadOnly? " & ActiveWorkbook.ReadOnly 'read only
wb.Close
SetAttr "C:\tmp\Test.xlsb", vbNormal
Set wb = Workbooks.Open("C:\tmp\Test.xlsb") 'read/write
Debug.Print "2. ReadOnly? " & ActiveWorkbook.ReadOnly
wb.Close
SetAttr "C:\tmp\Test.xlsb", vbReadOnly
Set wb = Workbooks.Open("C:\tmp\Test.xlsb")
Debug.Print "3. ReadOnly? " & ActiveWorkbook.ReadOnly 'read only
wb.Close
End Sub
Results:
OpenRW
1. ReadOnly? True
2. ReadOnly? False
3. ReadOnly? True
This is my current code
Public Sub OpenFiles()
'Set LiveDealSheet file path
'Check if LiveDealSheet is already open
LDSP = "C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm"
IsOTF = IsWorkBookOpen(LDSP)
'Set quick workbook shortcut
Set TWB = ThisWorkbook
If IsOTF = False Then
Set LDS = Workbooks.Open(LDSP)
Else
Workbooks("LiveDealSheet.xlsm").Activate
Set LDS = ActiveWorkbook
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
'i was just browsing through the online library and I found that "Open FileName For..."
'have a lot of keywords. If I only want to open the file and copy stuff out to
'another workbook do I use "Open FileName for Input Read As #ff"?
'Then when I actually open the file in OpenFiles() I change
'"Set LDS = Workbooks.Open(LDSP)" to "Set LDS = Workbooks.Open(LDSP) (ReadOnly)"
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
The file I am trying to open is a shared file. When no is it using, or when I already opened the file, this code works fine. But whenever another user already open a file, this code stops.
I know for a fact that even if another use is using the file, I can still open it in Read-Only mode. So my question is how to include that code in here, and hopefully without the pop-up asking if you want to open in Read-Only mode.
Sorry if this is a dumb question, but I am totally new to coding.
First of all thanks for you input. I have solve the problem on my own with some trial and error.
changed the code to the following
Public Sub OpenFiles()
'Set LiveDealSheet file path
'Check if LiveDealSheet is already open
LDSP = "Z:\LiveDealSheet.xlsm"
IsOTF = IsWorkBookOpen(LDSP)
'Set quick workbook shortcut
Set TWB = ThisWorkbook
If IsOTF = False Then
Set LDS = Workbooks.Open(LDSP)
Debug.Print "Stage 1 Success"
changed everything in this else statement
Else
On Error Resume Next
Set LDS = Workbooks("LiveDealSheet.xlsm")
If LDS Is Nothing Then Workbooks.Open FileName:=LDSP, ReadOnly:=True, IgnoreReadOnlyRecommended:=True
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I would replace all the scripted above with this:
Public Sub OpenFiles()
On Error GoTo not_open
Workbooks("C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm").Activate
Exit Sub
not_open:
Workbooks.Open FileName:="C:\Users\DCHEUNG\Desktop\Programing\LiveDealSheet.xlsm", ReadOnly:=True
Err.Clear
Resume Next
End Sub
I had the same issue and was helped somewhat by the existing posts, here. However, there was still a gap between the recommendations and reality. So, I'll try to share my lessons learned.
In my case, I needed Workbooks.Open to open the most recent file in a shared folder. This file is often referenced by other users and is therefore frequently open by other users. Below is my first pass to give the VBA code "permission" to open the file as "read only."
' OPEN SOURCE-FILE IN READ-ONLY MODE (argument key below)
Workbooks.Open _
Filename:=strFilename, _
UpdateLinks:=0, _
ReadOnly:=True, _
IgnoreReadOnlyRecommended:=True, _
Notify:=True
This actually works EXCEPT for when excel creates a temporary file in the source folder (the temp file will, therefore, always be the newest file in the folder). To handle that exception, I needed to truncate the temp characters: "~$". I have done that with
Right([your_string], integer_length_of_string)
See in context below.
For Each objFile In myFolder.Files
If InStr(1, objFile.Name, ".xlsm") And objFile.DateLastModified > dateFile Then
dateFile = objFile.DateLastModified
windowName = objFile.Name
If InStr(1, windowName, "~$") Then
fileNameLen = Len(objFile.Name) - 2
windowName = Right(objFile.Name, fileNameLen)
strFilename = myDir & "\" & windowName
End If
strFilename = myDir & "\" & windowName
End If
Next objFile