Excel keep getting locked from ms access vba code - excel

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

Related

MS Access Directory check and create using declared variable

I have appended a code I tested to copy and paste some data to Excel. i want to do 1) Check if directory exists 2) if it doesn't create it 3) if it does, display message box and stop the sub
Dim excelapp As Excel.Application
Dim wbTarget As Excel.Workbook
Dim qdfquerytest As QueryDef
Dim rsquerytest As Recordset
Set qdfquerytest = CurrentDb.QueryDefs("OpenComplaintsQuery") 'which query to define
Set rsquerytest = qdfquerytest.OpenRecordset() 'which recordset to open
Set excelapp = CreateObject("Excel.Application") 'create an Excel instance
excelapp.Visible = True 'Make Excel visible
If Len(Dir("O:\1_All Customers\Current Complaints\Complaint Folders\" &
rsquerytest(1).Value)) = 0 Then
MkDir "O:\1_All Customers\Current Complaints\Complaint Folders\ &
rsquerytest(1).Value"
Else
MsgBox "Folder already exists!", vbOKOnly
Exit Sub
End If
When i run i get runtime 75 error about file path isn't valid. I am pretty sure if the way i have the directory typed out to include rsquerytest(1) which is a serial number in the record. Additionally despite the error the code continues to run should i have put the If statement BEFORE setting Excel app?
Editting Post to post Code that is working
Private Sub cmdcopyfieldsonly_Click()
'This function works
'Things to add Checking for directory usage, Create the
directory, Stopping if directory is found and msg box,
'Declare and set excel objects and target data
Dim excelapp As Excel.Application
Dim wbTarget As Excel.Workbook
Dim qimsnum As Variant
Dim rsquerytest As Recordset
Set rsquerytest =
CurrentDb().OpenRecordset("OpenComplaintsQuery") 'which
recordset to open
Set qimsnum = Me.[QIMS#]
Dim savepath As String
Dim openpath As String
savepath = "Redacted filepath"
openpath = "Redacted Filepath"
'Set excelapp = CreateObject("Excel.Application") 'create an
Excel instance
'excelapp.Visible = True 'Make Excel visible
If Len(Dir(savepath & Me.[QIMS#], vbDirectory)) = 0 Then
MkDir savepath & Me.[QIMS#]
Else
MsgBox "Folder already exists!", vbOKOnly
Exit Sub
End If
I did leave portions after the If out as it does not pertain to this issue, June7 should have listened to you the first time i believe in a previous post you helped me with, I couldn't wrap my brain around it. and i am well aware this code can be cleaned up further ;), i am just working out the basic functions and will clean it up from there. Thank you for you support!

How to Close Excel application and workbook that is open and running in the background? [duplicate]

I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub

Access VBA - close Excel object

I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub

Allow Access user to select Excel worksheet for linking

So I am using VBA in Access to create linked tables between Excel and Access. Simple enough and as some online resources guided me I decided to utilize the TransferSpreadsheet command. So I ran some code to test out if I had the syntax correct and got this
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, _
"Link Name", "File Path", True, "Sheet Name!"
So that worked perfectly, but I wanted to automate it so someone who doesn't understand how to code can use the function. So for the file path I set up a file dialog box to come up so the user can select the excel file. Again worked great.
So now to the point, I want to create a dialog box for users to select the excel sheet to link as well. So essentially the user would select the excel file first and then select from a drop down box the sheet they want to link. Is this possible? If so how would I go about doing it. Here is my code so far:
Public Sub linksheet()
Dim fd As FileDialog
Dim strpath As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select Routing File"
'get the number of the button chosen
Dim FileChosen As Integer
FileChosen = fd.Show
If FileChosen <> -1 Then
Else
strpath = fd.SelectedItems(1)
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, _
"Test Link", strpath, True, "Current!"
End If
End Sub
To add to this further I was attempting to utilize this code I found to get the names but I'm unsure how to store them as variables to use.
Public Function WorkSheetNames(strwspath As String) As Boolean
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strarray(25)
Set xlApp = CreateObject("Excel.application")
Set xlBook = xlApp.Workbooks.Open(strwspath, 0, True)
For Each xlSheet In xlBook.Worksheets
Debug.Print xlSheet.Name
Next xlSheet
xlBook.Close False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Set xlSheet = Nothing
End Function
What the above code does is list out each sheet name into the debug window, I just am finding it difficult to push those values to an array.
I don't see why you need to store the sheet names in an array. You could store them as a list in a string variable. Then you could assign that string as the RowSource property of a combo box which allows the user to select one of the available sheets.
Dim strSheets As String
' adapt your existing code to use this ...
For Each xlSheet In xlBook.Worksheets
'Debug.Print xlSheet.Name
strSheets = strSheets & ";" & xlSheet.Name
Next xlSheet
' discard leading semi-colon
strSheets = Mid(strSheets, 2)
After you have collected the sheet names, apply them as the combo box source.
' ComboName should have Value List as Row Source Type
Me.ComboName.RowSource = strSheets

Updatelinks in Powerpoint from identical workbook in different directory (through vba?)

I am working on linking charts in powerpoint (ppt) slides to charts in Excel (xls) workbooks. This works fine without vba code, as I just use paste special to create a link. The problem is however when I change the directoy of the ppt as well as the xls, as the ppt will still try to update the data from the xls in the old directory. My goal however would be to share these files, so everyone can just update their ppt with their xls.
So, to put it shortly, I want to update the ppt, but choose a different workbook (with a different directory). This workbook will be identical to the old one in terms of structure, just with diffeerent data.
I know there is the method updatelinks, but there doesn't seem to be any way to choose a different directory with this method. Does anyone have any tips?
So, to put it shortly, I want to update the ppt, but choose a different workbook (with a different directory). This workbook will be identical to the old one in terms of structure, just with different data.
TRIED AND TESTED with MS-OFFICE 2010
I have commented the code so that you will not have a problem understanding it. If you still do then feel free to ask.
Option Explicit
Sub UpDateLinks()
'~~> Powerpoint Variables/Objects
Dim ofd As FileDialog
Dim initDir As String
Dim OldSourcePath As String, NewSourcePath As String
'~~> Excel Objects
Dim oXLApp As Object, oXLWb As Object
'~~> Other Variables
Dim sPath As String, OldPath As String, sFullFileOld As String
Dim oldFileName As String, newFileName As String
'Set the initial directory path of File Dialog
initDir = "C:\"
'~~> Get the SourceFullName of the chart. It will be something like
' C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1
OldSourcePath = ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName
Set ofd = Application.FileDialog(msoFileDialogFilePicker)
With ofd
.InitialFileName = initDir
.AllowMultiSelect = False
If .Show = -1 Then
'~~> Get the path of the newly selected workbook. It will be something like
' C:\Book2.xlsx
sPath = .SelectedItems(1)
'~~> Launch Excel
Set oXLApp = CreateObject("Excel.Application")
oXLApp.Visible = True
'~~> Open the Excel File. Required to update the chart's source
Set oXLWb = oXLApp.Workbooks.Open(sPath)
'~~> Get the path "C:\MyFile.xlsx" from
'~~> say "C:\MyFile.xlsx!Sheet1![MyFile.xlsx]Sheet1 Chart 1"
OldPath = Split(OldSourcePath, "!")(0)
'~~> Get just the filename "MyFile.xlsx"
oldFileName = GetFilenameFromPath(OldPath)
'~~> Get just the filename "Book2.xlsx" from the newly
'~~> Selected file
newFileName = GetFilenameFromPath(.SelectedItems(1))
'~~> Replace old file with the new file
NewSourcePath = Replace(OldSourcePath, oldFileName, newFileName)
'Debug.Print NewSourcePath
'~~> Change the source and update
ActivePresentation.Slides(1).Shapes(1).LinkFormat.SourceFullName = NewSourcePath
ActivePresentation.Slides(1).Shapes(1).LinkFormat.Update
DoEvents
'~~> Close Excel and clean up
oXLWb.Close (False)
Set oXLWb = Nothing
oXLApp.Quit
Set oXLApp = Nothing
End If
End With
Set ofd = Nothing
End Sub
Public Function GetFilenameFromPath(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = _
GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function

Resources