Cannot save file after upgrade to 2007 VBA - excel

I have a sub which I call to save a file
Sub SaveToFile()
maxr = Worksheets("List").Range("H1")
Worksheets("List").Range("G1:AE" & maxr).Copy
Part of the code which is failing after an upgrade to 2007 is:
With Application.FileSearch
.LookIn = "Q:\Planning Tools\Reports\"
.Filename = "Plan_" & ThisSaveTime & ".xls"
I receive a runtime error '445' object doesn't support this action, the code then continues below:
If .Execute > 0 Then 'Existing Workbook
Application.Workbooks.Open ("Q:\Planning Tools\Reports\Plan_" & ThisSaveTime & ".xls")
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Sheets("Sheet1").Select
ActiveWorkbook.Sheets("Sheet1").Name = ThisPlanSaveName
Else 'No existing Workbook, so add one
Workbooks.Add 1
ActiveWorkbook.Sheets("Sheet1").Select
ActiveWorkbook.Sheets("Sheet1").Name = ThisPlanSaveName
End If
End With
......
End Sub
I am not sure which action is failing but can anyone see why?
Thanks

Microsoft has removed FileSearch from the Excel 2007 Object Model
There are many possible replacements like Dir and using the FileSystemObject
try these links:
Mr Excel: Replacement class for FileSearch
MSDN Communities: Application.FileSearch in Excel 2007
Ozgrid Forums - Rplacement for FileSearch
Ozgrid Forums - Application.FileSearch Replacement in Excel 2007
Execl-IT.com: Replacement for FileSearch

Related

Excel 2016/2013 crashes running SaveAs method 2 times

I'd like to create several new workbooks. The VBA code below runs fine with Excel 365 and 2010. BUT with Excel 2013 or 2016, it runs fine the first time (and create the files)... and on the second run, Excel crashes without any error message.
If I run it step by step, I see that it's the SaveAs line that causes the crash.
I tried to kill the file before saving, too. To use a timer...
I tried to repair Office, to rename a HKEY (Identities), I tried to run it on 2 different windows (7 or 10). Nothing helps :/
Sub ExtraireType()
Dim shVentes As Worksheet
Dim rngVentes As Range
Dim rngTypes As Range
Dim shNew As Worksheet
Dim wkbNew As Workbook
Dim strPath As String
Dim zaza As Range
Application.DisplayAlerts = False
Set shVentes = ThisWorkbook.Worksheets("Ventes")
Set rngVentes = shVentes.Range("A1").CurrentRegion
Set rngTypes = ThisWorkbook.Worksheets("Liste").Range("A2:A4")
strPath = ThisWorkbook.Path
For Each zaza In rngTypes
rngVentes.AutoFilter
rngVentes.AutoFilter field:=3, Criteria1:=zaza.Value
rngVentes.Copy
Set shNew = ThisWorkbook.Worksheets.Add
shNew.Paste
Application.CutCopyMode = False
shNew.Move
Set wkbNew = ActiveWorkbook
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
wkbNew.Close
Set shNew = Nothing
Set wkbNew = Nothing
Next zaza
Set rngVentes = Nothing
Set shVentes = Nothing
Set rngTypes = Nothing
Application.DisplayAlerts = False
End Sub
This code runs well with Excel 2010 or 2019/365. But I have to use it with 2013 or 2016 :(
What am I doing wrong? Thanks for any help !
I was having this problem as well and have found a workaround - use .SaveCopyAs instead.
In the below example, .SaveAs crashes Excel every second time if I've left the Excel spreadsheet open and deleted the resultant file, whilst .SaveCopyAs saves every time irrespective. The only difference between the two is that .SaveAs has more options for how to save whereas .SaveCopyAs's only option is the filename.
Private Sub SaveAsExcelFile(TempExcelFile As Workbook, _
NewFullFileName as string, _
Optional FileFormat As XlFileFormat = xlOpenXMLWorkbook, _
Optional CreateBackup As Boolean = False)
'
' created & last edited 2020-03-06 by Timothy Daniel Cox
'
' For this example it is assumed the new file name is valid and in .xlsx format
'
Dim NewFullFileName2 as string
NewFullFileName2 = Replace(NewFullFileName, ".xlsx", "2.xlsx")
Application.EnableEvents = False
TempExcelFile.SaveCopyAs Filename:=NewFullFileName 'doesn't crash here on 2nd run
TempExcelFile.SaveAs Filename:=NewFullFileName2, FileFormat:=FileFormat, _
CreateBackup:=False 'will crash here on 2nd run
Application.EnableEvents = true
End Sub
I still think there is a bug in Excel regarding the .SaveAs however:
There's a long thread at
https://chandoo.org/forum/threads/worksheet-save-as-to-new-workbook-crashes-excel-on-second-run.40136/#post-241024
which after meandering has an apparent resolution as linked but - having
downloaded the file to see what changes have been made - he only
appears to have changed the output directory and removed a
conflicting fileformat which was set. IMO it did not resolve the
issue.
There's another similar unsolved thread at https://www.reddit.com/r/excel/comments/58fqlg/my_vba_code_works_at_first_but_if_used_twice_in_a/ which has no useful answers.
The one of the reasons that your code crash (it crushed in my case, Excel 2016), might be because you didn't add file extension at the end of:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
so it might be like:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd") & ".xlsx"
Hope it helps.

ActiveDocument.SaveAs2 not working in Excel 2000 but fine in 2010 and 2016

I have used a modified version of code supplied by Jtchase08 in another thread and it works fine in Excel 2010 and 2016 when I change the object library to the relevant Microsoft word version, however in an attempt to make the same thing work in 2000 I get
Run-time error '438': Object doesn't support this property or method
Debug takes me to here
The full code I am using is below, if anyone can help modify this to work in 2000 it would be much appreciated.
Sub ExportToHTML()
Dim DocPath As String
Dim MsgBoxCompleted
Worksheets("Final Code").Activate
Worksheets("Final Code").Range("A1:A322").Select
Dim AppWord As Object
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Selection.Copy
DocPath = CurDir & Application.PathSeparator & Range("U15")
'Create and save txt file
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
Application.CutCopyMode = False
AppWord.Quit (wdDoNotSaveChanges)
Set AppWord = Nothing
MsgBoxCompleted = MsgBox("Process complete.", vbOKOnly, "Process complete")
Worksheets("User Input").Activate
End Sub
I think the best solution would be
If Val(Application.Version) < 14 Then
AppWord.ActiveDocument.SaveAs Filename:=DocPath, FileFormat:=wdFormatText
Else
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
End If
So for versions before Office 2010 the old function SaveAs is used. And for Office 2010 and newer the new function SaveAs2 is used.
Information
The SaveAs2 function was introduced in Office 2010.
As I know the only difference is that the SaveAs2 function takes an additional (last) argument CompatibilityMode (see WdCompatibilityMode Enumeration).
So the old SaveAs might work in new versions as well, because it is still implemented for compatibility reasons. But we never know if it gets removed in any future versions so with the solution above you get compatibility to future versions in case the old SaveAs gets removed from VBA.

VBA macro in Excel 2016 for Mac: SaveAs will not work with a CSV file format

I am running a VBA macro in Excel 2016 for Mac. The macro works on Windows platforms with Excel 2016, and on Mac platforms with earlier than the 2016 version. The issue appears specific to Excel 2016 for Mac when trying to export a CSV.
The code is supposed to allow the user to click a button, which will then export an active worksheet to a CSV file. While a similar issue was documented here (Getting "method saveas of object _workbook failed" error while trying to save an XLSM as CSV), unfortunately while changing xlCSV to 6 worked for them, this has not worked for me.
The code works up until the ActiveWorkbook.SaveAs Filename:=newFileName, FileFormat:=6, CreateBackup:=False line, which then throws the error:
Run-time error '1004':Method 'SaveAs' of object '_Workbook' failed
If I change FileFormat to 51 (.xlsx) or 53 (.xlsm) the code will successfully finish. However, if FileFormat is set to 6 (.csv) the code will throw the error above. I am unable to SaveAs xlCSV or xlCSVMac.
My full script is below:
Sub btnExportCSV_Click()
Dim oldFileName As String
Dim newFileName As String
Dim timeStamp As String
Dim fileAccessGranted As Boolean
Dim filePermissionCandidates
Dim wsPath As String
timeStamp = Format(Now, "yyyymmddhhmmss")
wsPath = Application.ThisWorkbook.Path
oldFileName = ThisWorkbook.FullName
newFileName = Mid(oldFileName, 1, InStrRev(oldFileName, ".") - 1) & timeStamp & ".csv"
' Check if software is Office 2016 for Mac
' Documentation for this comes from https://dev.office.com/blogs/VBA-improvements-in-Office-2016
#If MAC_OFFICE_VERSION >= 15 Then
filePermissionCandidates = Array(wsPath)
fileAccessGranted = GrantAccessToMultipleFiles(filePermissionCandidates)
#End If
Application.DisplayAlerts = False
Sheets("OfflineComments").Activate
Sheets("OfflineComments").Copy
ActiveWorkbook.SaveAs Filename:=newFileName, FileFormat:=6, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
MsgBox ("Offline comments exported to " & newFileName)
Application.DisplayAlerts = True
End Sub
I have tried:
Adding a full path to the input/output file names
Ensuring that version of Excel is checked for and permissions allowed by user
Various file types for the FileFormat parameter, but as mentioned, only two types actually worked.
Trying the code mentioned in the above-linked article, which did not help (and which is why I am posting the original code here).
I Think its a bug, i have the same problem and i use a workaround:
ActiveWorkbook.SaveAs newFileName, CreateBackup:=False
Kill newFileName
ActiveWorkbook.SaveAs newFileName, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
This save my Workbook first as original file (xlsx), delete this and save as csv, its works for me.
Try this:
Application.ThisWorkbook.SaveAs ("C:\User\Folder\test.csv")
Also delete the line ActiveWorkbook.Save . You are double saving it.
I am using Excel 2010 and this work perfectly on my machine.
Try changing the permissions to explicitly request the new filename instead of the path by changing wsPath to newFileName:
#If MAC_OFFICE_VERSION >= 15 Then
filePermissionCandidates = Array(newFileName)
fileAccessGranted = GrantAccessToMultipleFiles(filePermissionCandidates)
#End If

Password Protect Excel Workbook from MS Access

I need to password protect entire workbook for opening. There's no need to protect the sheets as user will do some edits once reports are generated.Code runs within MS Access. Office Version is 2003. There's no possibility of using "SAVE AS" password protect method due to certain restrictions.
Can you please point out what I am doing wrong here?
Here's what I have tried so far:
Sub testProtection()
Dim xl As New Excel.Application
Dim wkbook As Workbook
Dim fileToOpen As String
On Error GoTo ExitMe
fileToOpen = "filepath & name"
Set wkbook = xl.Workbooks.Open(fileToOpen)
error in following lines: Automation Error Object invoked has disconnection from its client
wkbook.Protect Password:="100", Structure:=True, Windows:=True
wkbook.Close savechanges:=True
ExitMe:
MsgBox err.Description
Set xl = Nothing
Set wkbook = Nothing
Call cleanAllXLInstances
End Sub
PS: It's an incentive if the workaround could be compatible with MS 2010 as the tools will be migrated in the future - but not mandatory at this point. Plus I could manage it when looking at the API later on if current code can be worked out.
All I need to make sure, at this point Display Alerts = False to suppress the alerts for Saving As file with same name in same location. Which is contradictory to the initial constraints of the question asked though...
If xlPwd <> 0 Then
wkBook.SaveAs fileName:=fileToSaveAs, Password:=xlPwd, CreateBackup:=False
wkBook.Close
strMssg = " : Report is Protected!"
Else
strErrMssg = " : Report is NOT Protected!"
isWrapped = False
GoTo ExitMe
End If

Code for looping through all excel files in a specified folder, and pulling data from specific cells

I have about 50 or so Excel workbooks that I need to pull data from. I need to take data from specific cells, specific worksheets and compile into one dataset (preferably into another excel workbook).
I am looking for some VBA so that I can compile the results into the workbook I am using to run the code.
So, one of the xls or xlsx files I need to pull the data from, worksheet("DataSource"), I need to evaluate cell(D4), and if its not null, then pull data from cell(F4), and put into a new row into the compiled data set. Looping through all the Excel files in that folder as mentioned above.
And if possible, I would like the first data field in the first column the name of the file the data is being pulled from in the resulting dataset.
Can someone help me with this? I am looking for VBA because I am more familiar with that, but also interested in VBScript (as I am trying to get into that and learn the differences).
First start with this google query and click the first link that comes up, which takes you to an article showing how to iterate through a group of Excel files in a folder.
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
To get the name of the workbook, you'll want to adapt the code at "DO YOUR CODE HERE" to include wbResults.Name. If it's the filename you want, use wbResults.FullName, which returns the name of the workbook including its path on disk as a string.
A search for a VBScript variation on the same thing yields a number of results that are useful, including this script:
strPath = "C:\PATH_TO_YOUR_FOLDER"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xls" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
' Include your code to work with the Excel object here
objWorkbook.Close True 'Save changes
End If
Next
objExcel.Quit
I would do it in VBScript or even, VB.NET or Powershell if you feel so inclined.
Using VB.NET, you can access Excel spreadsheets as if they were databases, via the OLEDB provider. The code to select a range of values might look like this :
Try
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DtSet As System.Data.DataSet
Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
MyConnection = New System.Data.OleDb.OleDbConnection _
("provider=Microsoft.Jet.OLEDB.4.0;" _
" Data Source='testfile.xls'; " _
"Extended Properties=Excel 8.0;")
MyCommand = New System.Data.OleDb.OleDbDataAdapter _
("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
MyConnection.Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Once you get the data you can elaborate on it, then insert the result into another Excel spreadsheet, using the same API.
Getting the list of files is easy in .NET with a call to System.IO.Directory.GetFiles(); just specify the "*.xls" wildcard. Once you have the list, just use a for loop to iterate through it, opening each file in turn, then doing the query on that file, and so on.
If you use VBScript, then the preferred way to get the list of Excel files is to use the Scripting.FileSystemObject, specifically the GetFolder method. It works basically the same way but the syntax is slightly different.
If it's VBScript or VB.NET it will probably run outside of Excel itself. You'd run it by double-clicking or from a batch file or something like that. The advantage to using VB.NET is you could put up a graphical form for interaction - it could show a progress bar, tracking how many files you've gone through, status updates, that kind of thing.
Whenever you are accessing that many Excel files in succession, you can generally get better performance using ADODB rather than Excel's automation object.
I agree with using that accessing the Excel object is not the quickest and if the workbooks and sheets that you're trying to retrieve data from are all consistent (i.e have the same column names, etc... or at least the column names you're looking for) it would be better to use ODBC. This does have some issues and if you can't get around them or need to actually do something more complex based on the contents then there may be no way around it. If that's the case then I would suggest creating one Excel object and then opening and closing the files as needed to try to increase the efficiency.
It could be done with the following code
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("V:\XX\XXX\*.xlsx")
Do While Len(StrFile) > 0
Debug.Print StrFile
Set wbResults = Workbooks.Open("V:\XX\XXX\" & StrFile)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=True
StrFile = Dir
Loop
End Sub

Resources