Loop Freezing Excel After Printing - excel

I have a spreadsheet that creates a CSV file and deposits the CSV file in a folder next to the original file. The spreadsheet seems to work fine. When you have your data entered, you click export, and a CSV file is put in a folder called "Uploads" that is next to the original file.
The issue is when I use the quick print button on my Excel quick access toolbar. When I click the quick print button, everything seems to print fine. However, as soon as I close the file, (EDIT: ALL Printing seems to be freezing the file. As soon as the file is closed) Excel then goes into a freeze where it looks like it is trying to run some code? I am a novice in VBA so I am not sure what is happening, all I know is that after my file is closed, Excel freezes up and I have to restart Excel. I do not even have any macros or VBA for an Excel close or Excel open trigger.
Can anyone recreate the issue and give me insight into how my code might be doing this?
Private Sub Export_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = ActiveWorkbook.Path & "\Uploads"
MyFileName = "" & Range("a2") & "_Upload"
On Error GoTo Ending
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("UploadData").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook 'Saves the new workbook to given folder / filename:
.SaveAs FileName:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False 'Closes the file
.Close False
End With
ChDir MyPath
Workbooks.Open FileName:= _
MyPath & "\" & MyFileName & """"
ActiveWorkbook.Save
ActiveWorkbook.Close
GoTo Skip
Ending:
MsgBox ("ERROR! Please make sure you have a folder named Uploads next to the template file")
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Skip:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

This actually shouldn't work at all, regardless of what you do before you run it. First, you ensure that MyPath ends with a \ here...
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
...but then when you (re)build the same path below you're inserting a second \:
Workbooks.Open FileName:= _
MyPath & "\" & MyFileName & """"
This should always fail. You can avoid this entire problem with paths by using the Scripting.FileSystemObject's .BuildPath function:
'Requires a reference to Microsoft Scripting Runtime.
Dim filePath As String, fso As New Scripting.FileSystemObject
filePath = fso.BuildPath(ThisWorkbook.Path, MyFileName)
You can also use this for the file extension:
If LCase$(fso.GetExtensionName(MyFileName)) <> "csv" Then
MyFileName = MyFileName & ".csv"
End If
Note that this test will never be true...
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
...because MyFileName will always end with "load":
MyFileName = "" & Range("a2") & "_Upload"
Also, you should remove all the references to ActiveWorkbook. I have no idea why printing would effect this, but there isn't anything else I can identify that should be an issue. I'd structure it more like this (error handler removed for clarity - don't put it back until you're finished debugging it):
'Add a reference to Microsoft Scripting Runtime.
Private Sub Export_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With New Scripting.FileSystemObject
Dim filePath As String
Dim targetDir As String
targetDir = .BuildPath(ThisWorkbook.Path, "Uploads")
If Not .FolderExists(targetDir) Then
MsgBox ("ERROR! Please make sure you have a folder named Uploads next to the template file")
Exit Sub
End If
filePath = .BuildPath(targetDir, ActiveSheet.Range("A2").Value & "_Upload.csv")
End With
'Copies the sheet to a new workbook:
Dim csv As Workbook
Set csv = Application.Workbooks.Add
With csv
ThisWorkbook.Sheets("UploadData").Copy .Sheets(1)
.SaveAs Filename:=filePath, _
FileFormat:=xlCSV, _
CreateBackup:=False 'Closes the file
.Close xlDoNotSaveChanges
End With
'Reopen and re-save to fix formatting.
Set csv = Workbooks.Open(filePath)
csv.Close xlSaveChanges
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Related

Xlookup Macro re-opening already open file

I need to automate a report I run for when I'm out of office, but this one section keeps failing me. How do I stop it from asking me to open an already open file? I cannot figure out what I missed. This is later repeated again in code elsewhere and causes the same issue as I'm referencing the same file.
ChDir "H:\SCOSBaker\Backlog Reports\Oracle Backlog"
Workbooks.Open Filename:= _
("H:\SCOSBaker\Backlog Reports\Oracle Backlog\Backlog_" & Format(Now(), "MMDDYY") & ".xlsx")
Dim FilenameSufffix As String
FilenameSuffix = Format(Now(), "MMDDYY")
Dim XLSXFilename As String
XLSXFilename = "Backlog_" & FilenameSuffix & ".xlsx"
ActiveCell.FormulaR1C1 = _
"=XLOOKUP(RC[3],[XLSXFilename]Copy_Of_Query_SO_Config_Lines!C19,[XLSXFilename]Copy_Of_Query_SO_Config_Lines!C7)"
You can do it like this:
Const FPATH As String = "H:\SCOSBaker\Backlog Reports\Oracle Backlog\"
Dim wb As Workbook, fName As String
fName = "Backlog_" & Format(Now(), "MMDDYY") & ".xlsx"
On Error Resume Next
Set wb = Workbooks(fName) 'try to get a reference: ignore error if not open
On Error GoTo 0 'stop ignoring errors
'if not open then open it...
If wb Is Nothing Then Set wb = Workbooks.Open(FPATH & fName)

Opening ASCII file in Excel with VBA for multiples files- Loop is running in the same output file Instead of next file

I have multiple ascii files in a folder. I want to open each ascii file with delimiter comma, then I want to do some operation and save the file as Excel work book without overwriting the ascii file. Like this need to do for many files ascii file using macro. Anyone help me write excel macro code.
In the loop need to open the ascii file and do the my job then save the file as Excel file in the final folder.then reading next ascii file in the files actually.
But my code is opening the the first ascii file doing the my job, then
saving as new Excel file. Instead of opening the next ascii file, it
is doing the job on the saved Excel file.
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ThisWorkbook.path & "\files\"
Filename = Dir(Pathname)
Do While Filename <> ""
Call Workbooks.OpenText(Filename:=Pathname & Filename, DataType:=xlDelimited, Comma:=True)
Set wb = ActiveWorkbook
DoWork wb
wb.SaveAs Filename:=wb.path & "\final\" & wb.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ConflictResolution:=True
wb.Saved = True
wb.Close
'wb.Close SaveChanges:=True
'Filename = Dir(Pathname & "*.xlsx")
Loop
MsgBox "Successfully Completed. Developed By Siddhu"
End Sub
Sub DoWork(wb As Workbook)
With wb
myjob goes here in each file
End With
End Sub
You need to do somthing like that
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ThisWorkbook.path & "\files\"
Filename = Dir(Pathname)
Do While Filename <> ""
Call Workbooks.OpenText(Filename:=Pathname & Filename, DataType:=xlDelimited, Comma:=True)
Set wb = ActiveWorkbook
DoWork wb
wb.SaveAs Filename:=wb.path & "\final\" & wb.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ConflictResolution:=True
wb.Saved = True
wb.Close
'wb.Close SaveChanges:=True
'Filename = Dir(Pathname & "*.xlsx")
Filename = Dir `<=== this will go to the next file in the directory
Loop
MsgBox "Successfully Completed. Developed By Siddhu"
End Sub

Cannot open Workbook in read/write mode

I'm trying to apply different macros to every excel file present in a folder adding several sheets to them, and to do so I'm looping over all the files in the folder and opening them one by one.
However, I stumbled upon the issue that, every workbook I open is in read only mode, thus preventing me from saving it after having modified it.
Setting the ReadOnly parameter to False, and the IgnoreReadOnlyRecommended parameter to True doesn't change anything, and the workbook still opens as a read only workbook.
Sub RunOnAllFilesInFolder()
Dim folderName As String, fileName As String
Dim wb As Workbook
folderName = "H:\mypath"
fileName = Dir(folderName & "\*.xlsx")
Debug.Print (fileName)
Do While fileName <> ""
Set wb = Workbooks.Open(fileName:=folderName & "\" & fileName, ReadOnly:=False, IgnoreReadOnlyRecommended:=True)
MsgBox (wb.ReadOnly)
wb.Activate
Call my_sub
Application.DisplayAlerts = False
wb.SaveAs (folderName & "\" & fileName)
wb.Close SaveChanges:=False
Set wb = Nothing 'clean up
Application.DisplayAlerts = True
Debug.Print "Processed " & folderName & "\" & fileName
fileName = Dir()
Loop
End Sub
Would anyone know why the file opens as a read only file (despite being just a regular excel file), or another way to modify these files and save the changes?

How to save xlsm as xlsx?

I have a xslm file. I want to save the file as xlsx and email.
I am able to SaveCopyAs it as xls file. If I try to save it as xlsx, it does get saved but when I open it, it gives an error.
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy") & ".xlsx"
Excel cannot open the file '...path\MyFileName.xlsx' because the file format or file extension is not valid. Verify that file has not been corrupted and that file extension matches the format of the file
SaveCopyAs does not change the file-type.
You simply cannot save a .xlsm as .xlsx via SaveCopyAs.
EDIT
a workaround is to save a copy which then is changed in type while the old copy will be deleted like:
Dim wb As Workbook, pstr As String
pstr = ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy") & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename:=y
Set wb = Workbooks.Open(pstr)
wb.SaveAs Left(pstr, Len(pstr) - 1) & "x", 52
wb.Close False
Kill pstr
Try this:
Sub SaveAsXLSX()
ThisWorkbook.Save 'Optional
Application.DisplayAlerts = False
ThisWorkbook.SaveAs ActiveWorkbook.Path & "\MyFileName - " & Format(Date, "mm-dd-yyyy"), 51 '51 = xlsx
Application.DisplayAlerts = True
ThisWorkbook.Close 'Optional
End Sub
All you need to do is SaveAs and change the file format to 51 (xlsx)
If you want to "Save a copy" - SaveAs does practically the same thing - the difference being your currently open file becomes the saved file, but you can simply reopen the old one if you wish and nothing changes.
What you actually want to do is SaveAs a different file type, so use SaveAs.
I This is more readable. TESTED.
Sub SaveXlsmAsXlsx()
Dim wb As Workbook, Filenamepath As String, Filenameext As String, Filenameonly As String, Filepathonly As String
Application.DisplayAlerts = False
Filenamepath = ActiveWorkbook.FullName
Filenameext = ActiveWorkbook.Name
Filenameonly = Replace(Filenameext, ".xlsm", "")
Filepathonly = Replace(Filenamepath, ".xlsm", "")
Set wb = Workbooks.Open(Filenamepath)
'51 = xlsx
wb.SaveAs Filename:=Filepathonly & "_" & Format(Date, "mm-dd-yyyy"), FileFormat:=51
wb.Close True
'Kill- Best not to kill anyone, you might be sorry
ThisWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub
This code add to any module:
Public Sub XLSMtoXLSX(FaylAdi As String)
Dim FullPath As String
Dim wb As Workbook
MsgBox "YOU WILL GET A WARNING AFTER COMPLETED, PLEASE WAIT"
ThisWorkbook.Save
On Error GoTo XETA
'You can change the name of the folder path below
FullPath = "C:\kohne sistem\Excel\VBA\Anbar\temp\" & FaylAdi & ".xlsm"
ThisWorkbook.SaveCopyAs FullPath
Application.DisplayAlerts = False
Set wb = Workbooks.Open(FullPath)
wb.SaveAs Left(FullPath, Len(FullPath) - 1) & "x", 51
wb.Close False
Kill FullPath
Application.DisplayAlerts = True
MsgBox "COMPLETED CORRECTLY"
Exit Sub
XETA: MsgBox "THERE WAS A FAULT SOMEWHERE"
End Sub
Then you can use it like this:
Private Sub CommandButton1_Click()
Call XLSMtoXLSX(Date)
End Sub

Export sheet as new Excel file (values only)

I found code in this discussion which has been extremely helpful for exporting Excel sheets as a new workbook. I've posted the version of the code that I currently use below.
As this code stands, it copies the content of the desired sheet to a new workbook, formulas and all.
Is it possible to modify this code to copy values only to this new workbook?
I appreciate any insight anyone can lend.
Sub ExportXLSX()
'exports desired sheet to new XLSX file
Dim MyPath As String
Dim MyFileName As String
Dim DateString As String
DateString = Format(Now(), "yyyy-mm-dd_hh_mm_ss_AM/PM")
MyFileName = DateString & "_" & "Whatever You Like"
If Not Right(MyFileName, 4) = ".xlsx" Then MyFileName = MyFileName & ".xlsx"
Sheets("Desired Sheet").Copy
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Where should we save this?"
.AllowMultiSelect = False
.InitialFileName = "" '<~~ The start folder path for the file picker.
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With
NextCode:
With ActiveWorkbook
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With
End Sub
See revised NextCode section for solution:
NextCode:
With ActiveWorkbook
.ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value '<~~ converts contents of XLSX file to values only
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close False
End With

Resources