I am writing some VBA code within an MS Projects file, which will run every time the user saves the file.
The code will export the file to excel, and then save the excel as a csv file.
Since this will happen each time the Project is saved, most of the time a file of the same name will already exist, and therefore the pop will appear asking the user if they wish to replace the file.
I would like the process to supress this pop-up and automatically replace the file.
The following is an extract from my macro, which supresses the pop-up for the excel part of the code, but not for the csv - I guess because that's not part of the 'application'.
Application.DisplayAlerts = False
Newfn = "filepath\filename"
FileSaveAs Name:=Newfn & ".xlsx", FormatID:="MSProject.ACE", map:="Map Name"
'export to csv
Dim objXL As Object
Dim objWB As Object
Dim objWS As Object
Set objXL = CreateObject("Excel.Application")
Set objWB = objXL.workbooks.Open(Newfn & ".xlsx")
Set objWS = objWB.worksheets(1)
objWS.SaveAs Newfn & ".csv", xlCSV
objWB.Close
Application.DisplayAlerts = True
Is there something else I can use to prevent the pop up for the csv conflict?
Related
I have daily excel reports that get created by an external program. I am looking to automate a simple row formatting on these reports. They always have the same number of columns, however, different number of rows.
This is the macro I have in place: (it does the job as expected when run on a single xlsm file, which is not ideal)
Sub FormatLeadLists()
Application.DisplayAlerts = False
Columns("A:F").Select
Selection.ColumnWidth = 8.29
Columns("A:F").EntireColumn.AutoFit
Range("A1").Select
Selection.CurrentRegion.Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Table1"
Range("Table1[#All]").Select
End Sub
This is the .vbs code that I run from a batch file:
Dim args, objExcel
Set args = WScript.Arguments
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open args(0)
objExcel.Visible = True
objExcel.Run "FormatLeadLists"
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close(0)
objExcel.Quit
This works well on a single file, however, to make this work I have to create my macro in my "All Open workbooks" and have to save my excel as an xlsm file.
That's not ideal if I have these reports overwritten every day as xlsx files.
How can I create a macro in my personal workbook so I don't have to save the report as xlsm and so I can apply the same macro on the other xlsx reports?
I know I should even be able to create a .vbs file that loops through my windows folder and applies the macro on all existing excel files.
Edit:
Code for the loop (from comments):
Dim strFileName As String
Dim strFolder As String: strFolder = "C:\myfiles\"
Dim strFileSpec As String: strFileSpec = strFolder & "*.*"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Debug.FormatLeadLists strFileName
strFileName = Dir
Loop
I have a VBA program that pulls data from a network location, processes the data, and then saves it as a single CSV file. This loop will create over a 1000 separate CSV files.
The error that I get is that seemingly at random, the saving dialog box will just get stuck. It's like it's saving the file, but never completes, and will sit there indefinitely. If I hit cancel, the macro just proceeds. (I blacked out the file name)
My code for this is:
Application.ScreenUpdating = False
counter = 2
Do Until ThisWorkbook.Sheets("Production_Data").Cells(Counter, 5).Value = ""
'''' Main operations go here ''''
'Save workbook to new file
Application.DisplayAlerts = False
'move worksheet to new workbook
Set newbook = Workbooks.Add(1) 'create new workbook object with only 1 sheet
newbook.Sheets(1).Name = "toDelete" 'name the worksheet
ws.Activate 'activate the temporary worksheet to be moved
Sheets(tempSheetName).Move Before:=newbook.Sheets(1)
newbook.Sheets("toDelete").Delete 'remove the blank sheet created in new workbook
'save as CSV file
fname = destPath & "/" & tempSheetName & ".csv"
newbook.SaveAs FileName:=fname, FileFormat:=xlCSV
newbook.Close
Application.DisplayAlerts = True
counter = counter + 1
loop
Application.ScreenUpdating = True
Is there any way to automatically exit this "frozen" dialog box and continue the macro? Is there something wrong with my code? Ideally this could be avoided all together.
The only other idea I've had is that my excel book with the macro is on a network drive, and maybe somehow that gets it to freeze up somehow?
edit
I tried adding set newbook = Nothing after closing it, but it still remains open in the VBA Project manager.
I have a requirement from the client in which they want us to rename the column from multiple excel sheets which are present in the same directory.
There are 70+ excel reports and we are not sure that the particular column is present in which excel file. So every time they ask us to change, all the time we have to drill down all the excel sheets to find out the changes required which is really time consuming.
I thought of automating the process. Since all the files are present under the same directory, can't we use a MACRO,BATCH/UNIX SCRIPTS or any other way by which we can traverse the entire directory and make those changes by performing a find and replace thing.
So my first question is, if this is feasible ? If yes, then can anyone suggest/advice how to work around on this process ?
Thanks in Advance
I can't take full credit for the below as this is a patchwork of code I have used over the years. This is how I would go about it personally:
Manually make a copy of the files to change and place them in a folder (keep the originals safe!)
Let the code open each file and change it
Code will save a copy in a different 'done' folder
The example below loops through each Excel file and moves it from the 'to-do' folder to the 'done' folder once it has changed the cell "A1" to "Hello World". When the 'to-do' folder is empty the code stops.
You'll need to change the file paths for this to work.
Sub Example()
Dim FolderPath As String, FilePath As String, FileCount As Integer
Dim objExcelApp As Object
Dim wb As Object
Dim SaveName As String
FolderPath = "C:\Users\********\Desktop\To Do\"
NewFolderPath = "C:\Users\********\Desktop\Done\"
FilePath = FolderPath & "*.xl??"
FileName = Dir(FilePath)
ChangeNextFile:
FileCount = 0
'count how many files in "files to be changed" folder
Do While FileName <> ""
FileCount = FileCount + 1
FileName = Dir()
Loop
'if there are no files left end the code
If FileCount = 0 Then GoTo FinishedLoadingFiles
'choose the first file to change
FileName = Dir(FilePath)
Debug.Print FileName
'create an instance of Excel
Set objExcelApp = CreateObject("Excel.Application")
With objExcelApp
.Visible = False
.DisplayAlerts = False
End With
'opens the excel file in the background
objExcelApp.Workbooks.Open FileName:=FolderPath & FileName, UpdateLinks:=False
Set wb = objExcelApp.ActiveWorkbook
objExcelApp.ActiveWindow.Activate
'changes cell "A1" to say "hellow world"
wb.Sheets(1).Cells(1, 1).Value = "Hello World"
'saves the file in the done pile
wb.saveas NewFolderPath & FileName '& ".xlsb"
'closes excel
With objExcelApp
.DisplayAlerts = True
End With
wb.Close
objExcelApp.Quit
Set wb = Nothing
Set objExcelApp = Nothing
'deletes the original file. New file has been saved in the new folder
Kill FolderPath & FileName
GoTo ChangeNextFile
FinishedLoadingFiles:
MsgBox "All done"
End Sub
I am trying to export current workbook to HTML site with current timestamp using this code
Private Sub btnSave_Click()
ActiveWorkbook.Save 'Save current file
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName ' Remeber location of original file
NewFileType = "Web files File (*.HTML), *.html" 'Set file type
Newfilename = "Shed9-" & Format(CStr(Now), "yyyy-mm-dd_hh-mm") 'Save as timestamp
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=Newfilename, _
fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=xlHtml
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub
In theory this procedure should save current file, save copy (with a time stamp, ignoring VBA) as a web page, close the web page (which to be honest I don't even want to open) and get back to the original spreadsheet.
Unfortunately the problem is with the closing part: Excel opens the web page (!) and then I have never-ending pop-up question "Do you want to save the file "Shed-9 .html?"
So how can I remove that pop-up and simply export without opening?
EDIT
I've tried to force-save the HTML copy before closing by putting the
ActBook.Save
ActBook.Close
But that leads to an error:
"An item with the same key has already been added". If thats important the workbook has multiple sheets and data taken through PowerQuery
EDIT
(The original code came from here) - the original author should receive his/her credit
Try:
ActBook.Close False
If you save a workbook in a non-excel format it will ask you if you want to save the file again anyway, without fail. Using the optional "False" parameter tells excel that you want to close without saving.
You could safely skip these lines, where you actually ask Excel to do just that (open the file):
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
I think what might confuse you is that have turned off screen updating, which hides what happens to you (behind the scenes).
Application.ScreenUpdating = False
This is all good if you really want to hide what's going on, but I imagine it might confuse you as long you have the Workbooks.Open code.
I have created an xlam (Excel 2007 Add-In) file to handle manipulation of various files. I am trying to write a procedure in that xlam file that removes some worksheets from an opened xlsm file, and saves it as an xlsx (i.e. without macros).
So far the only thing I can do reliably is to crash Excel whenever I reach the .SaveAs call. The crash comes as a Windows Dialog stating:
Microsoft Office Excel has stopped working, Windows can try to recover your information and restart the program. [Restart the program] [Debug the Program]
In the folder that I am saving to, after every crash I am left with a temp file (ex. filename: 7A275000 with size: 0) in the folder it tried to save to.
For posterity here some things I have tried, and all have resulted in the same crash:
Hard coded filename value ("C:\Users\myUserName\Desktop\temp.xlsx")
Prompted filename from User (shown in code below)
filename without path ("temp.xlsx")
filename without extension ("C:\Users\myUserName\Desktop\temp")
filename as existing filename without extension
filename as existing filename with .xlsx extension
instead of using wb.SaveAs, I used wb.Activate followed by ActiveWorkbook.SaveAs
I have tried FileFormat:=xlOpenXMLWorkbook and FileFormat:=xlWorkbookNormal
Saved to several different directories of varying length
Added an Error trapping statement around the .SaveAs call (it does not trap any errors, and crashes Excel just the same)
The last weird bit is when I try to do a manual Save-As on the file (i.e. navigating to the Save-As menu myself) after the ws.delete calls, Excel crashes the same way. If I manually delete the Worksheets myself, then do a manual Save-As, it saves just fine.
Here is the offending code:
Public Sub ConvertToStagingFile(ByRef wb As Workbook)
Dim reWS As Object, reFILE As Object
Dim ws As Worksheet
Set reWS = CreateObject("VBScript.regexp")
reWS.IgnoreCase = True: reWS.Global = False: reWS.MultiLine = False
Set reFILE = CreateObject("VBScript.regexp")
reFILE.IgnoreCase = True: reFILE.Global = False: reFILE.MultiLine = False
reWS.Pattern = "^(home|location settings|date reference|[\w\s]{1,8} (rating|inquire) data|pkl data - \w{1,8}|verbs - \w{1,8})"
reFILE.Pattern = "\.xlsm$"
For Each ws In wb.Worksheets
If (ws.Visible = xlSheetHidden) Or (ws.Visible = xlSheetVeryHidden) Then
ws.Visible = xlSheetVisible
End If
Select Case True
Case reWS.test(ws.name)
'// Do Nothing
Case Else
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Select
Next ws
ActiveWindow.TabRatio = 0.75
If (reFILE.test(Cached.getAdhocReportFull)) Then
Dim newName As Variant
newName = Application.GetSaveAsFilename(reFILE.Replace(Cached.getAdhocReportFull, ""), "*.xlsx")
If newName = False Then Exit Sub
wb.Activate
Application.EnableEvents = False
'// CODE RELIABLY CRASHES HERE
wb.SaveAs _
FileName:=newName, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.EnableEvents = True
End If
End Sub
Any help on this issue would be greatly appreciated.
I had what seems like exactly the same issue:
Excel 2013
Macro to delete worksheet in xlsm file
Subsequent calls to .Save, or manually saving file crashes Excel (same dialog as Hari)
The issue only appeared for us when we updated from .xls to the 'new' office file format
For info, our files are not that large (only 300kB)
As our intention is to replace the sheet the following works for us: rename old worksheet, create new worksheet (same name as old worksheet), delete the old worksheet. Seems to work for us. Why does it work? No idea.