I'm keeping an ID for API in an encrypted excel file (open to alternative suggestions) and using Microsoft access VBA to open the encrypted excel and extract the ID.
The issue is that it will not close excel if the password is incorrect. This code works fine if you enter the password correctly
Public Function getDeploymentID() As String
Dim fileLocation As String
fileLocation = "___DeploymentID.xlsx"
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Dim wb As Excel.Workbook
On Error GoTo getDeploymentID_ERROR
MsgBox "The development password is in a password protected excel. It will prompt you for the password next"
Set wb = Workbooks.Open(fileLocation, True)
'User must enter password to continue. If they don't it'll error out on above line
DoEvents
'Get deploymentID
getDeploymentID = wb.Worksheets("Sheet1").Cells(1, 1)
'Close it
'wb.Close 'will close workbook, won't close excel
wb.Application.Quit 'will close workbook and excel
DoEvents
GoTo getDeploymentID_Cleanup
getDeploymentID_ERROR:
Debug.Print "Failed to open DeploymentID excel file. Error " & err.Number & ":" & err.description
objExcel.Quit 'THIS IS NOT WORKING
DoEvents
getDeploymentID_Cleanup:
Set wb = Nothing
Set objExcel = Nothing
End Function
I believe you need to access the Workbooks collection through the objExcel.
Set wb = objExcel.Workbooks.Open(fileLocation, True)
Then,
wb.Close 'close workbook
objExcel.Quit 'quit excel app
References:
Workbook.Close
Application.Quit
Regarding the structure of the function, I would add the error handling at the bottom and call Resume to avoid the 2nd GoTo statement.
'...
On Error GoTo getDeploymentID_ERROR
'...
'Get deploymentID
getDeploymentID = wb.Worksheets("Sheet1").Cells(1, 1)
getDeploymentID_Cleanup:
wb.Close
objExcel.Quit
Exit Function
getDeploymentID_ERROR:
Debug.Print "Failed to open DeploymentID excel file. Error " & err.Number & ":" & err.description
Resume getDeploymentID_Cleanup
End Function
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 am trying to export excel from ms access vba code. I am able to do most of the part except couple of problems.
1) The excel application keep getting locked and when i try to open spreadsheet it says spreadsheet locked for editing by myself. I have released all the variables at the end as well but still no luck.
2) I am not able to open the new "Saved As" spreadsheet automatically and also need to close the original spreadsheet.
I searched extensively on google and went through other questions on stackoverflow but could not figure it out.
Requirement - I want to export excel from ms access. I need take the existing spreadsheet, replace its contents when my code runs and then save as to another worksheet keeping original spreadsheet unchanged. I need to also open the new spreadsheet and present to the user. Here is my code:
Private Sub GenerateReport(strFileName As String)
Set xlObj = CreateObject("Excel.Application")
Dim xlWB As Workbook
Dim xlSheet As Worksheet
Dim fpath As String
Dim path As String
Dim fname As String
With xlObj
On Error goto errorHandler
.DisplayAlerts=False
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "tableName", strFileName, True
Set xlWB = Workbooks.Open(strFileName) 'strFileName consist of full path of spreadsheet
xlWB.Activate
fdate = "20200521"
path = xlWB.path
' Some code for formatting excel spreadsheet
fname = "Temp" & fdate
xlWB.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Set xlWB = Nothing
Set xlObj = Nothing
procdone:
Set xlWB = Nothing
Set xlObj = Nothing
Exit Sub
errorHandler:
Resume procdone
End With
End Sub
I am running a batch file which calls a vbs script to open a workbook, execute a macro (which calls several subs and functions), creates an email and displays it, saveas a version of the workbook, and then close down the workbook and close down the process.
For some reason after execution, the workbook will close, but I will still have a blank excel process running regardless of what I do. Everything else is working fine aside from the lone process that gets stuck running. How do I get rid of the ghost instance I end up with? Why am I getting stuck with an excel process?
Batch Script Calling the VBS Process:
cscript update.vbs "C:\Test\Batch\AutoUpdate\Summ.v1.xlsm"
VBScript:
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = True
objExcel.Run "NewRunAll"
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Quit
set objExcel = Nothing
WScript.Quit
VBA Save Down Process in Book :
Public Sub SaveDownBook()
'Saves down a copy of the entire workbook
Dim filePath As String, fileName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo saveDownBook_bailOut
filePath = Sheet7.Range("copy_filepath").Value
fileName = Sheet7.Range("historical_filename").Value
ThisWorkbook.SaveCopyAs (filePath + fileName)
ActiveWorkbook.Close
saveDownBook_bailOut:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then
MsgBox ("Error Description: " + Err.Description)
MsgBox ("Error Number: " + Err.Number)
End If
End Sub
I have a macro that will open another workbook from a network location, compare some values in a range, copy/paste any that are different, and then close the file. I use variables to open the file, because the appropriate filename is based on the current date. I also set Application.ScreenUpdating = False, and Application.EnableEvents = False
for some reason, the code has begun to hang on the worksheets.open line and I can't even CTRL+Break to get out of it. I have to manually close Excel and sometimes it give me an error message, complaining about there not being "enough memory to complete this action".
I can put a stop in the code and confirmed the variables are supplying the correct string, which equates to:
"\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm"
I can paste this into Windows Explorer and it will open right up with no issues. I can manually select the file from Explorer and it will open with no issues. I can paste the following line into the immediate window and it will hang...
workbooks.Open("\\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm")
This happens even if I open a blank sheet and execute that line from the immediate window.
from my macro, stepping through the code goes without a hitch. I can verify all the variables are correct, but when it steps across workbooks.open, it hangs.
I have other macros that open workbooks, do much more complicated routines, then close them with zero issues, but I'm really stuck on why this one is giving me so many problems.
Any ideas?
Here is the code:
'This will open the most recent meeting file and copy over the latest for jobs flagged with offsets
Dim Path As String
Path = ThisWorkbook.Path
'Debug.Print Path
Dim FileDate As String
FileDate = ThisWorkbook.Sheets("MEETING").Range("3:3").Find("PREVIOUS NOTES").Offset(-1, 0).Text
'Debug.Print FileDate
Dim FileName As String
FileName = "PROD MEETING " & FileDate & ".xlsm"
Debug.Print "Looking up Offsets from: " & FileName
Dim TargetFile As String
TargetFile = Path & "\" & FileName
Debug.Print TargetFile
Application.ScreenUpdating = False
Application.EnableEvents = False
'The old way I was opening it...
'Workbooks.Open FileName:=Path & "\" & FileName, UpdateLinks:=False ', ReadOnly:=True
'The most recent way to open
Dim wb As Workbook
Set wb = Workbooks.Open(TargetFile, UpdateLinks:=False, ReadOnly:=True)
'Do Stuff
wb.Close savechanges:=False
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Offsets should now reflect settings made in meeting on " & FileDate
End Sub
If the workbook you're opening contains code in the Workbook_Open event then this will attempt to execute when the event fires .
To stop this behaviour use the Application.AutomationSecurity Property.
Public Sub Test()
Dim OriginalSecuritySetting As MsoAutomationSecurity
OriginalSecuritySetting = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
'Open other workbook
Application.AutomationSecurity = OriginalSecuritySetting
End Sub
Prelude
I am starting a new project, and basically I am using Excel as a log for another program I am using. With this being said, this is a mixture of VBA (Only when using Excel's object) and VB6 (the main "host" programming language). This is why both languages are tagged as I anticipate hateful comments from the use of tags; I am looking for a solution in either/mixture of both programming languages!!
Also, I am aware some VBA activists will say to never use ActiveSheet. I am not concerned about this and I would like to say thank you ahead of time. I have one sheet in this workbook as it's primary function is to serve as a log. The ActiveSheet will always be the one and only sheet.
I have the following code, and I am not too familiar with Setting a workbook as an object, which is likely the reason I receive the Bad Index error.
Sub Test()
' Checking if Excel is open, if not, open it.
Dim xL As Object, wBook As Object, iCloseThings As Byte
On Error Resume Next
Set xL = GetObject(, "Excel.Application")
On Error GoTo 0
If xL Is Nothing Then
iCloseThings = 1 ' Set Excel to close only if it was never open
Set xL = CreateObject("Excel.Application")
End If
Set wBook = xL.Workbooks("C:\Users\<UserName>\Documents\<WorkBook>.xlsx").ActiveSheet
If iCloseThings = 1 Then xL.Quit
End sub
What I need assistance with is how would I properly set this object to point to the exact workbook I have in the above example? All I have ever known to do was something such as Set wBook = XL.Workbooks("<WorkBook>.xlsx").ActiveSheet because I knew such workbook would already be open. But with the possibility of it not being open, I need something a little more flexible.
Thanks for your assistance!
you need some different cases handling, mainly depending if the wanted workbook is already open or not should a running Excel session be "caught"
you may want to use some dedicated Functions not to clutter your main code and be more effective in both debugging and maintaining your code, like follows
Option Explicit
Sub Test()
' Checking if Excel is open, if not, open it.
Dim xL As Object, wBook As Object, wSheet As Object, iCloseThings As Byte
Set xL = GetExcel(iCloseThings)
Set wBook = GetExcelWorkbook(xL, "C:\Users\<UserName>\Documents\<WorkBook>.xlsx")
If wBook Is Nothing Then Exit Sub
Set wSheet = wBook.ActiveSheet
If iCloseThings = 1 Then xL.Quit
End Sub
Function GetExcel(iCloseThings As Byte) As Object
On Error Resume Next
Set GetExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If GetExcel Is Nothing Then
iCloseThings = 1 ' Set Excel to close only if it was never open
Set GetExcel = CreateObject("Excel.Application")
End If
End Function
Function GetExcelWorkbook(xL As Object, wbFullName As String) As Object
Dim wbName As String
wbName = Right(wbFullName, Len(wbFullName) - InStrRev(wbFullName, "\"))
On Error Resume Next
Set GetExcelWorkbook = xL.Workbooks(wbName)
On Error GoTo 0
If GetExcelWorkbook Is Nothing Then
Set GetExcelWorkbook = xL.Workbooks.Open(wbFullName)
Else
If GetExcelWorkbook.Path & "\" & wbName <> wbFullName Then
MsgBox "A workbook with the wanted name '" & wbName & "' is already open but its path doesn't match the required one" _
& vbCrLf & vbCrLf & "Close the already open workbook and run this macro again", vbCritical + vbInformation
Set GetExcelWorkbook = Nothing
Else
MsgBox "Wanted workbook is already open", vbInformation
End If
End If
End Function