I currently have a code to delete files in a userform. I enter a reference and this in term populates to a sheet and all the calculations are worked out.
What I am trying to do is delete the old existing document and then save a new copy with the word "CLOSED" in the title. I feel this code should work but cannot see why it is not finding the specified file.
Sub CloseDoc()
Dim FSO
Dim sFile As String
sFile = "M:\Documents\" & Range("B3").Text & " - " & Range("B14").Text & ".xlsx"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFile) Then
FSO.DeleteFile sFile, True
MsgBox "Deleted The File Successfully, Ready to update with CLOSED information", vbInformation, "Done!"
Else
MsgBox "Specified File Not Found", vbInformation, "Not Found!"
End If
Sheets("ITC").Copy
Range("A1:B54").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-60
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
'Save Document to Dir
ActiveWorkbook.SaveAs Filename:= _
"M:\Documents\" & Range("B3").Text & " - " & Range("B14").Text & " - CLOSED" & " .xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End Sub
Related
I have a code, where I want to:
Save Masterfile (current active workbook),
amend the workbook and delete sheets,
then save separate copies of the edited workbook
as an Excel sheet and a PDF file.
The problem I have here is that the code saves the PDF file as the original Masterfile even after I have tried to activate the edited Excel file. Any help here? Would really appreciate any advice! Code below:
ActiveWorkbook.Save
Sheets("Inventory").Select
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Sheets("May").Select
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("Macro").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False
Sheets("Oct").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False
Sheets("Inventory").Select
Range("A1").Select
Sheets("Inventory").Cells.Interior.ColorIndex = 0
ChDir "G:\9Fixed\Posi\2016\Inventory"
ActiveWorkbook.SaveAs Filename:= _
"G:\9Fixed\Posi\2016\Inventory\Asia Fixed - " & Format(Date, "dd mmm") & ".xls", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = False
'ActiveWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
Workbooks("Asia - " & Format(Date, "dd mmm") & ".xls").Activate
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"G:\9Fixed Income\Positions\2016\Inventory\Asia Fixed Income - " & Format(Date, "dd mmm") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
I could not reproduce the issue you were having.
Here is my 'test' code, using a workbook with 4 sheets and information in cells(1,1), one sheet named "May" --- which is deleted, and the new file does not have "May" and the pdf does not either.
I moved the saveas code towards the top of the file. Maybe that will fix your issue, but I don't believe it will.
Option Explicit
Sub SaveCopies()
Dim c_OUTPUTDIR As String
Dim sFileName As String
Dim fso As Object ' Used to handle paths, filenames, etc.
Set fso = CreateObject("Scripting.FileSystemObject")
c_OUTPUTDIR = "C:\temp\"
' Save the master copy.
ActiveWorkbook.Save
' Generate new name for file.
sFileName = fso.GetBaseName(ActiveWorkbook.FullName) & "_" & Format(Date, "dd mmm")
' Save new working file.
ActiveWorkbook.SaveAs Filename:= _
c_OUTPUTDIR & sFileName & ".xls", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
' Make changes to working file.
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("May").Delete
Application.DisplayAlerts = True
' Save the changes.
ActiveWorkbook.Save
' Save a PDF of the file.
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
c_OUTPUTDIR & sFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
In summary, the code below copies all the information on a sheet and pastes the information on a new excel sheet while keeping the formatting. That document is then saved with the naming convention of the active sheet name and the current date. This sheet is saved in two places and then closes itself. When I run the code all the steps occur but the document does not save into the two folders and the error message pops up and stops the code there. Can you please check out my code and see why it does not work? Thank you in advance!
Sub SaveXLST()
'
' SaveXLST Macro
'
Dim monthVal As Integer
Dim mVal As String
Dim dayVal As Integer
Dim dVal As String
Dim yearVal As Integer
Dim yVal As String
monthVal = Month(Date)
dayVal = Day(Date)
yearVal = Year(Date)
If monthVal < 10 Then
mVal = "0" & monthVal
Else
mVal = "" & monthVal
End If
If dayVal < 10 Then
dVal = "0" & dayVal
Else
dVal = "" & dayVal
End If
Cells.Select
Range("A9").Activate
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-12
Application.CutCopyMode = False
ChDir "N:\D\IG\C\~ P"
ActiveWorkbook.SaveAs Filename:= _
"N:\D\IG\C\~P\T" & "-" & yearVal & "." & mVal & "." & dVal, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ChDir "N:\D\IG\C\T"
ActiveWorkbook.SaveAs Filename:= _
"N:\D\IG\C\T\T" & "-" & yearVal & "." & mVal & "." & dVal, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub
Here is your code with some minor adjustments / improvements (including the ones suggested by #ScottCraner and #Charlie in their comments).
Option Explicit
Sub SaveXLST()
'
' SaveXLST Macro
'
Dim monthVal As Integer
Dim dayVal As Integer
Dim yearVal As Integer
Dim xlsNewFile As Workbook
monthVal = Month(Date)
dayVal = Day(Date)
yearVal = Year(Date)
Application.CutCopyMode = False
'Indicate here from which sheet you want to copy
ThisWorkbook.Worksheets("Sheet1").Range("A9").Copy
Set xlsNewFile = Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-12
Application.CutCopyMode = False
If Dir("c:\tmp", vbDirectory) = vbNullString Then
'If Dir("N:\D\IG\C\~ P", vbDirectory) <> vbNullString Then
MsgBox "No such path: N:\D\IG\C\~ P" & Chr(10) & "Skipping first save!"
Else
xlsNewFile.SaveAs Filename:= _
"c:\tmp\" & "-" & yearVal & "." & Format(monthVal, "00") & "." & Format(dayVal, "00") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End If
If Dir("N:\D\IG\C\T\T", vbDirectory) = vbNullString Then
MsgBox "No such path: N:\D\IG\C\T\T" & Chr(10) & "Not saving to second location!"
Else
xlsNewFile.SaveAs Filename:= _
"N:\D\IG\C\T\T" & yearVal & "." & Format(monthVal, "00") & "." & Format(dayVal, "00") & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End If
xlsNewFile.Close
End Sub
Let me know if this solved your problems / errors.
I have a template that fills certain cells with sales data from another workbook but the other workbook has a new name for each month. When I try to assign a variable as the workbook name so that it finds it each time, I can't get the index/match function to work. Not sure where the error is but is the point where the VBA script fails...
Sub GetNetSales()
Dim Period As String
Dim NS As Workbook
Dim Can As Workbook
Dim BookName As String
Period = Range("Per").Value
Set Can = ThisWorkbook
ChDir "C:\Users\dlibby\Documents\" & Period
Workbooks.Open Filename:= _
"C:\Users\dlibby\Documents\" & Period & "\Net Sales " & Period & ".xlsx"
Set NS = ThisWorkbook
Can.Activate
Range("C10").Select
ActiveCell = _
Application.IfError(Application.Index(NS.Sheets("CM Sales").Columns("E:E"), Application.Match(Can.Range("H10").Value, NS.Sheets("CM Sales").Columns("A:A"), 0)), 0).Value
Range("C10").Select
Selection.Copy
Range("C11:C12").Select
ActiveSheet.Paste
Range("C16:C22").Select
ActiveSheet.Paste
Application.Calculate
Range("C10:C12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C16:C22").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
When I am using Index/Match in Macro I am typing formula like this:
Folder = Sheets("Overview").Range("F4")
filename = Sheets("Overview").Range("G4")
filetype = Sheets("Overview").Range("H4")
tabname = Sheets("Overview").Range("I4")
style = Sheets("Overview").Range("J4")
SAPsizecode = Sheets("Overview").Range("K4")
ActiveCell.Formula = "=INDEX('" & Folder & "\[" & filename & filetype & "]" & tabname & "'!$" & SAPsizecode & ":$" & SAPsizecode & ",MATCH(C2,'" & Folder & "\[" & filename & filetype & "]" & tabname & "'!$" & style & ":$" & style & ",0))"
And this works for me. I think the problem in your code is how you are assigning the workbooks. With the approach above you don't need to open another workbook.
I am trying to save an Active sheet in Excel using following VBA:
Application.CutCopyMode = False
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Activeworkbook.close
but I am having two issues here:
1- When I want to open the file I am encountring with following Message:
Manually opening the file is OK by pressing the Yes but I am going to use the Excel File in GIS software which causing problem because of misunderstanding of format. As you can see it has .xls format
2- the Activeworkbook.close is not functioning since I have to close the Application after running the code by my own!
The first part is very important for me, to understand why this is happening? can you please let me know why?
You are using the wrong file format.
For .xls it is xlExcel8. xlOpenXMLWorkbookMacroEnabled is for .xlsm
Either use this
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlExcel8
or use this
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=FName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Regarding your 2nd question. Change your code to this
Application.DisplayAlerts = False
FName = "C:\Users\Public\Documents\DTMForGIS\DTMtoGIS" & _
Format(Now, "yyyy-mm-dd hh_mm_ss") & ".xls"
ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlExcel8
With ActiveSheet.UsedRange
.Copy
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
Application.Quit
-Summary:
I'm trying write code that will automatically save with the name of the current date
-Problem: Error saying "Method 'SaveAs' of object '_Workbook' failed" pops up when compiler reaches the line that saves. Everything else works. I've shown the whole function for references' sake.
Function createRecord()
Dim rowCount As Integer
Dim theDate As Date
theDate = Format(Now(), "MM-DD-YY")
Sheets("New Data").Select
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Application.ActiveSheet.Name = "ChaseHistory"
ActiveSheet.Paste
rowCount = ActiveSheet.UsedRange.Rows.Count
Sheets("Exceptions").Select
'rowCount = ActiveSheet.UsedRange.Rows.Count
Application.CutCopyMode = False
ActiveSheet.UsedRange.Rows.Select
Selection.Copy
Sheets("ChaseHistory").Select
ActiveSheet.Range("A" & rowCount + 2).Select
ActiveSheet.Paste
Range("A1").Select
Cells.Select
Selection.Copy
ChDir "Z:\Customer_Service_Accounting\REPORTING & CONTROLS TEAM\Book And Balance_Katie\Chase Booking History" 'loads the crystal report
Workbooks.Open Filename:= _
"Z:\Customer_Service_Accounting\REPORTING & CONTROLS TEAM\Book And Balance_Katie\Chase Booking History\Do_Not_Delete.xlsx"
Windows("Do_Not_Delete").Activate
ActiveSheet.Paste
Application.DisplayAlerts = False
'---------------This is the problem child-------------- 'SAVING WORKBOOK
ActiveWorkbook.SaveAs Filename:="Z:\Customer_Service_Accounting\REPORTING & CONTROLS TEAM\Book And Balance_Katie\Chase Booking History\" & CStr(theDate), FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = True
End Function
-I added in the convert to string method on date because I thought that might be causing the problem but had the same result. Let me know if you see anything wrong here. Thanks!
The Problem: because in my code I was disabling prompts from excel, when I was trying to save I wasn't seeing a prompt telling me that I was attempting to save with an improper format.
Basically to sum it up, Excel didn't like that I had backslashes ("/") in my filename (which I really should have known)
The Fix: I ended up using this statement:
ActiveWorkbook.SaveAs Filename:="Z:...\" & "Chase " & _
Month(theDate) & "_" & Day(theDate) & "_" & Year(theDate) & ".xlsx"
So all I really did here was post month, day, and year together into a string separated by underscores to avoid the evil backslash.
Thanks for your help Gaffi!
Have you tried something like this?
ActiveWorkbook.SaveAs Filename:="Z:\Customer_Service_Accounting\REPORTING & CONTROLS TEAM\Book And Balance_Katie\Chase Booking History\" & Format(theDate, "mm.dd.yy"), FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
To highlight: I changed CStr(theDate) to Format(theDate, "mm.dd.yy") & ".xlsx", but you can use other formats if needed.
Explanation:
theDate is of type Date (see: Dim theDate As Date), so what is returned is a complete date/time format string when you use CStr(). This will result in something like this:
Debug.Print CStr(Now())
7/6/2012 7:23:38 AM
Which will likely cause your system to reject for invalid characters in the filename.