Code is below which was working fine, now does not seem to like the ".xlsm" section. problem is on all PCs. I tried using the Filename= and a few variants and have pinned it down to "." (period) that it does not accept in ".xlsm", delete the period and it is fine but then lands in SharePoint as an unknown file (with no file extension). Any advice appreciated!
Sub SUBMIT()
Dim FName As String
FName = Range("E3").Text
FDate = Range("I3").Text
If Range("E3") = "" Then
MsgBox "Please Enter Your Name"
Range("E3").Select
ElseIf Range("I3") = "" Then
MsgBox "Please Enter Fortnight Ending Date"
Range("I3").Select
ElseIf Range("I3") <> "" Then
If MsgBox("Are you sure? (Have you entered your supervisor(s) and Fortnight End Date in the top panel ?", vbYesNo) = vbNo Then Exit Sub
ActiveWorkbook.SaveAs ("https://*****.sharepoint.com/corp/payroll/Timesheets" & FName & " " & FDate & " " & "Timesheet" & "xls")
MsgBox "Timesheet Submitted"
End If
End Sub
You should supply the file path without the extension and use the FileFormat parameter of the ActiveWorkbook.SaveAs() function.
In your case, you should change the row to this
ActiveWorkbook.SaveAs ("https://*****.sharepoint.com/corp/payroll/Timesheets" & FName & " " & FDate & " " & "Timesheet"), 52
The 52 I added at the end is the value for xlOpenXMLWorkbookMacroEnabled as described here
The code below works well for me on Win7 Excel2013
Sub StackOverflow()
ActiveWorkbook.SaveAs "C:\Temp\myfile", 52
End Sub
Related
This is my first question on this platform, so please forgive any mistake I might make.
I have a couple of excel workbooks that I would like to make multiple exact changes to exact sheets and exact cells in all of them, but they are way too many to do individually.
I recorded all the changes I am to make in a macro using one of the workbooks;
Sub Macro1()
Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("R35:X35").Select
Selection.Cut
Range("R34").Select
ActiveSheet.Paste
Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
Range("V179:V182").Select
End Sub
I ran this macro in another different unmodified workbook and it worked perfectly.
I'm quite new to using VBA, but I was able to find a block of code online that makes a change in multiple excel files in a specified directory;
Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
' Change directory path as desired
dirName = "c:\myfiles\"
MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile
Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do
Workbooks.Open MyFile
With ActiveWorkbook
For Each wks In .Worksheets
' Specify the change to make
wks.Range("A1").Value = "A1 Changed"
Next
End With
ActiveWorkbook.Close SaveChanges:=True
MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub
I edited it to fit my needs like so;
Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
Set wks = ActiveWorkbook.Worksheets("SHEET X")
' Change directory path as desired
dirName = "/Users/Account/Desktop/Directory 1/Directory 2/"
MyPath = dirName & "*.xls"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile
Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do
Workbooks.Open MyFile
With ActiveWorkbook
For Each wks In ActiveWorkbook.Worksheets
' Specify the change to make
wks.Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
wks.Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
wks.Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
wks.Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
wks.Range("R35:X35").Select
Selection.Cut
wks.Range("R34").Select
ActiveSheet.Paste
wks.Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
wks.Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
wks.Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
wks.Range("V179:V182").Select
Next
End With
ActiveWorkbook.Close SaveChanges:=True
MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub
I ran it and it did nothing and returned no error. I'm really at my wits' end here and I would really appreciate any help.
P.S I'm a mac user
Well, 120 simultaneous open tabs(no joke, I counted 😂) and two sleepless nights later, I finally found a solution. NOTE: THIS WORKS ON MAC ONLY, apparently I think Dir doesn't work on Mac, thanks to #Jeeped for pointing that out, so for other Mac users with my issue, this is what I did:
Option Explicit
'Important: this Dim line must be at the top of your module
Dim dirName As String
Sub ChangeFiles()
Dim MySplit As Variant
Dim FileIndirName As Long
Dim wks As Worksheet
'Clear dirName to be sure that it not return old info if no files are found
dirName = ""
Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=1, FileFilterOption:=0, FileNameFilterStr:="SearchString")
If dirName <> "" Then
With Application
.ScreenUpdating = False
End With
MySplit = Split(dirName, Chr(13))
For FileIndirName = LBound(MySplit) To UBound(MySplit)
Workbooks.Open (MySplit(FileIndirName))
Set wks = ActiveWorkbook.Worksheets("SHEET X")
With wks
.Range("W4:X4") = "OFF -PEAK GEM(MW)"
.Range("J33:M33") = "Hz"
.Range("B33:I33") = "DETAILS"
.Range("R34:X34").EntireRow.Insert Shift:=xlShiftDown
.Range("R35:X35").Cut Destination:=Range("R34")
.Range("K68:L123").Delete Shift:=xlToLeft
.Range("K68:L68") = "UNITS ON BAR"
.Range("V178") = "EXPECTED RESERVE"
End With
ActiveWorkbook.Close SaveChanges:=True
Next FileIndirName
With Application
.ScreenUpdating = True
End With
Else
MsgBox "Sorry no files that match your criteria, A 0 files result can be due to Apple sandboxing: Try using the Browse button to re-select the folder."
With Application
.ScreenUpdating = True
End With
End If
MsgBox "Done!"
End Sub
'*******Function that do all the work that will be called by the macro*********
Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, _
FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
Dim ScriptToRun As String
Dim folderPath As String
Dim FileNameFilter As String
Dim Extensions As String
On Error Resume Next
folderPath = MacScript("choose folder as string")
If folderPath = "" Then Exit Function
On Error GoTo 0
Select Case ExtChoice
Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)" 'xls, xlsx , xlsm, xlsb
Case 1: Extensions = "xls" 'Only xls
Case 2: Extensions = "xlsx" 'Only xlsx
Case 3: Extensions = "xlsm" 'Only xlsm
Case 4: Extensions = "xlsb" 'Only xlsb
Case 5: Extensions = "csv" 'Only csv
Case 6: Extensions = "txt" 'Only txt
Case 7: Extensions = ".*" 'All files with extension, use *.* for everything
Case 8: Extensions = "(xlsx|xlsm|xlsb)" 'xlsx, xlsm , xlsb
Case 9: Extensions = "(csv|txt)" 'csv and txt files
'You can add more filter options if you want,
End Select
Select Case FileFilterOption
Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' " 'No Filter
Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' " 'Begins with
Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' " ' Ends With
Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' " 'Contains
End Select
folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
Chr(34) & " to return quoted form of it's POSIX Path")
folderPath = Replace(folderPath, "'\''", "'\\''")
If Val(Application.Version) < 15 Then
ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
Level & """)" & Chr(13)
ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
ScriptToRun = ScriptToRun & "foundPaths"
Else
ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
Level & """ "
End If
On Error Resume Next
dirName = MacScript(ScriptToRun)
On Error GoTo 0
End Function
By the way, #urdearboy thanks for your suggestion, it really helped, although I had problems with the .PasteSpecial, I still found a workaround.
For anyone wondering, what the code does when you run it is it basically brings up a dialog box asking you to chose your desired folder, when you do, it finds files with the .xls extension (you can change that) and performs the change in all .xls files in that folder.
Thanks to everyone who commented on this post. ^_^
Note: this is not meant to be a solution and will be deleted. Just wanted to make a suggestion for OP
You should update your excel operations as follows.
This Link will show you alternatives to the .Select method.
With wks
.Range("W4:X4") = "OFF -PEAK GEM(MW)"
.Range("J33:M33") = "Hz"
.Range("B33:I33") = "DETAILS"
.Range("R34:X34").Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("R35:X35").Copy
.Range("R35:x35").ClearContents
.Range("R34").PasteSpecial
.Range("K68:L123").Delete Shift:=xlToLeft
.Range("K68:L68") = "UNITS ON BAR"
.Range("V178") = "EXPECTED RESERVE"
End With
I am trying to create a macro that, upon save, asks the user if the file they are working is the final version. If it is, I would like to save a copy of that file in a different destination. It also creates an indicator with the username and date saved of the final copy so that if a user tries to create ANOTHER final copy, it asks them if they would like to overwrite the version created by [username] on [date].
I decided to use AfterSave as opposed to BeforeSave, as I would like the user to have the option of choosing between Save and SaveAs before the macro runs.
The issue that I am having is that if the user indicates that it is the final version, a copy is saved, triggering the AfterSave event. Is there a line of code I can add that would stop the AfterSave event after the file copy is saved?
Here is my current code.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success Then
Call YesNoMessageBox
End If
End Sub
'Saves copy of tool if final version
Sub YesNoMessageBox()
Dim Answer1 As String
Dim MyNote1 As String
Dim fileName As String
Dim dlgOpen As FileDialog
Dim MyYear
Dim FilePath
Dim Answer2 As String
Dim MyNote2 As String
MyNote1 = "Is this the FINAL version?"
'Display MessageBox
Answer1 = MsgBox(MyNote1, vbQuestion + vbYesNo, "???")
If Answer1 = vbYes Then
If Not Worksheets("Data Input").Range("M2") = vbNullString Then
MyNote2 = "There is already a version saved by " & Worksheets("Data Input").Range("M2") & " on " & Worksheets("Data Input").Range("M3") & "." & vbNewLine & "Would you like to overwrite it?"
Answer2 = MsgBox(MyNote2, vbQuestion + vbYesNo, "???")
If Answer2 = vbYes Then
strUName = CreateObject("WScript.Network").UserName
Worksheets("Data Input").Range("M2") = strUName
Worksheets("Data Input").Range("M3") = Date
'Saves copy of tool in [folder name] folder
MyYear = Year(Worksheets("Data Input").Range("D13"))
ThisWorkbook.SaveAs fileName:="G:\[file path]" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Copy of tool saved in" & Application.ThisWorkbook.Path
End If
Else
strUName = CreateObject("WScript.Network").UserName
Worksheets("Data Input").Range("M2") = strUName
Worksheets("Data Input").Range("M3") = Date
'Saves copy of tool in [folder name]folder
MyYear = Year(Worksheets("Data Input").Range("D13"))
ThisWorkbook.SaveAs fileName:="G:\[File Path]\" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Copy of tool saved in" & Application.ThisWorkbook.Path
End If
End If
End Sub
Disable events before the SaveAs but don't forget to enable again after:
Application.EnableEvents = False
ThisWorkbook.SaveAs fileName:="G:\[File Path]\" & Worksheets("Data Input").Range("D9") & " - " & Worksheets("Data Input").Range("D7") & " " & MyYear & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.EnableEvents = True
I have a script that is used to save an excel template based on the contents of two cells/named ranges (FailReportSN and FailReportDD). My issue is that the end users do not always remember to enter values into those two cells before running the save as script below. What I need to do is modify my current script to only save if there are values in both cells.
Sub saveAsFATPMM()
Dim PathMac As String, Path As String, FolderPath As String
If Application.PathSeparator = ":" Then
FolderPath = "Volumes:Server:Groups:METI:Quality Control:METIman:"
PathMac = FolderPath & Sheets("Failure Report").Range("FailReportSN").Text & _
" - FATP - " & Sheets("Failure Report").Range("FailReportDD").Text & ".xlsm"
'Format(Date, "mm-dd-yy")
ThisWorkbook.SaveAs Filename:=PathMac, FileFormat:=53, CreateBackup:=True
Else
FolderPath = "\\server\server\Groups\METI\Quality Control\METIman\"
Path = FolderPath & Sheets("Failure Report").Range("FailReportSN").Text & _
" - FATP - " & Sheets("Failure Report").Range("FailReportDD").Text & ".xlsm"
'Format(Date, "mm-dd-yy")
ThisWorkbook.SaveAs Filename:=Path, FileFormat:=52, CreateBackup:=True
End If
MsgBox "Your file has been saved. Thank you."
End Sub
Use conditional If to check for those values first. In the code below I check to make sure the Len of that Range is not 0 (or False in this case, since 0 equates to False here). I also refactored a bit to get rid of essentially duplicate code.
Sub saveAsFATPMM()
With Sheets("Failure Report")
If Len(.Range("FailReportSN")) And Len(.Range("FailReportDD")) Then
Dim PathMac As String, Path As String, FolderPath As String, fFormat as Long
If Application.PathSeparator = ":" Then
FolderPath = "Volumes:Server:Groups:METI:Quality Control:METIman:"
fFormat = 53
Else
FolderPath = "\\server\server\Groups\METI\Quality Control\METIman\"
fFormat = 52
End If
Path = FolderPath & .Range("FailReportSN").Text & _
" - FATP - " & .Range("FailReportDD").Text & ".xlsm"
ThisWorkbook.SaveAs Filename:=Path, FileFormat:=fFormat, CreateBackup:=True
MsgBox "Your file has been saved. Thank you."
Else
MsgBox "File not saved! Enter Fail Report Values and Try Again!"
End If
End With
End Sub
excuse my english, it is not good, but I hope you can understand me.
I have a problem with my VBA code that I use in Excel 2010 on windows without problems, but his not working on mac excel 2011.
I have changed from pc to mac and I don't know the mac system and I not can find the solution.
this is my code:
Private Sub Workbook_Open()
Dim strJahrgang As String
Dim strKlasse As String
Dim strNr As String
Dim mPath As String
Dim mFoto As String
mPath = ThisWorkbook.Path & "\Foto"
Application.ScreenUpdating = False
strJahrgang = Worksheets("Register").Range("D18")
strKlasse = Worksheets("Register").Range("E36")
' Schleife über alle Tabellenblätter
For i = 1 To Sheets.Count
' Tabellenname enthält "schüler_"
If InStr(Sheets(i).Name, "schüler_") > 0 Then
With Sheets(i)
' Nr. aus dem Tabellennamen
strNr = Format(Application.Substitute(.Name, "schüler_", ""), "00")
' Bildnamen zusammensetzen
mFoto = strJahrgang & " Klasse " & strKlasse & " - " & strNr & " " & _
.Cells(1, 5) & " " & .Cells(1, 8)
' in laufender Tabelle ist kein Bild vorhanden
If .Shapes.Count = 0 Then
' benötigtes Bild ist im Ornder vorhanden
If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then
.Pictures.Insert (mPath & "\" & mFoto & ".jpg")
With .Pictures(.Pictures.Count)
.Top = Range("G5").Top
.Left = Range("G5").Left
.Height = Range("G5:G12").Height
.Width = Range("G5:J5").Width
End With
DoEvents
' Bild ist im Ordner nicht mehr vorhanden
Else
' Bild löschen
If .Shapes.Count > 0 Then .Shapes(1).Delete
End If
' in laufender Tabelle ist Bild vorhanden
Else
' wenn Bild im Ordner nicht merh vorhanden dann Bild löschen
If Dir(mPath & "\" & mFoto & ".jpg") = "" Then .Shapes(1).Delete
End If
mFoto = ""
End With
End If
Next i
Application.ScreenUpdating = True
End Sub
I have understand the mac use ":" where win use "/", so I think to must change "/" with ":".
my problem is a runtime error 68 on this line
If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then
.Pictures.Insert (mPath & "\" & mFoto & ".jpg")
I think mac don't like the command "Dir" and can not find the directory "Foto". probably I must use a MacID but I don't know how I must use it and my english to understand it are to bad.
I use the code to insert automatically the photo from my students in the schoolregister. the code search the schoolyear on the page "register" cell e18 and the class in cell e36. in page "schüler_1", "schüler_2" etc. in the cells e1 he found the last name and h1 first name from evrey stundent. With this informations the code search in the order "Foto" that stay in the same place how the excelfile the right foto of the stundents and insert it on cells g5:j12. example "2014-15 klasse 1a - 01 Ciccio Bello"
I hope someone can please help me, thanks.
dan
This link should give you the information you require for file and folder operations on the Mac.
EDIT
#T J Noted and thank you
#muma I don't use the Mac for VBA much so may not be able to respond in great detail. However, from the link, it seems you require a function to test for files/folders. Apparently Mac has difficulty with long file names?
For your specific Q, the below test code and function should enable you to test whether a file or folder exists. The first argument in the function determines whether the check is for a file or folder: 1 = file, 2 = folder. You will need to provide your own path/filename in the function call. My example file name just happens to be 'Workbook2.csv' in the code below.
Sub macTest()
Dim isfl As Boolean
If FileOrFolderExistsOnMac(1, "<your disk name>:Users:<your user name>:Documents:Workbook2.csv") Then
MsgBox "Yes it exists"
Else
MsgBox "Sorry file doesn't exist"
End If
End Sub
Function FileOrFolderExistsOnMac(FileOrFolder As Long, FileOrFolderstr As String) As Boolean
'By Ron de Bruin
'30-July-2012
'Function to test whether a file or folder exist on a Mac.
'Uses AppleScript to avoid the problem with long file names.
Dim ScriptToCheckFileFolder As String
ScriptToCheckFileFolder = "tell application " & Chr(34) & "Finder" & Chr(34) & Chr(13)
If FileOrFolder = 1 Then
ScriptToCheckFileFolder = ScriptToCheckFileFolder & "exists file " & _
Chr(34) & FileOrFolderstr & Chr(34) & Chr(13)
Else
ScriptToCheckFileFolder = ScriptToCheckFileFolder & "exists folder " & _
Chr(34) & FileOrFolderstr & Chr(34) & Chr(13)
End If
ScriptToCheckFileFolder = ScriptToCheckFileFolder & "end tell" & Chr(13)
FileOrFolderExistsOnMac = MacScript(ScriptToCheckFileFolder)
End Function
I have the following question. I use a file to log assets (laptops, desktops etc) into certain folders, like deployed, stock, repair and hotswap.
I made some buttons in it which work all fine. One button called deployed, when I save the sheet with this button it saves it with EU IMAC, serial number and date as XLMS file.
I like to change the code from this button, so that when I save a sheet as deployed it automatically delete the XLMS file with serial number and name in the folder stock.
Below the codes for all the save buttons and it's button 61 that needs to be fixed, the others I will change afterwards. The code is form other forum, but with no success.
Sub Button60_Click()
Range("A1:G68").PrintOut
End Sub
Sub Button51_Click()
ActiveWorkbook.SaveAs "C:\Users\rjbakkex\Documents\Assets_logging\Hotswap\" & Format(ActiveWorkbook.Worksheets("EU IMAC").Range("B26").Value) & " - Hotswap -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
End Sub
Sub Button53_Click()
ActiveWorkbook.SaveAs "C:\Users\rjbakkex\Documents\Assets_logging\Returned to stock\" & Format(ActiveWorkbook.Worksheets("EU IMAC").Range("B26").Value) & " - Return to stock - " & Format(Date, "yyyy-mm-dd") & ".xlsm"
End Sub
Sub awaitwuhan_Click()
ActiveWorkbook.SaveAs "C:\Users\rjbakkex\Documents\Assets_logging\To repair\" & Format(ActiveWorkbook.Worksheets("EU IMAC").Range("B26").Value) & "- Repair -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
End Sub
Sub Button61_Click()
p = "C:\Users\rjbakkex\Documents\Assets_logging\Deployed\"
'opslaan
s_name = Sheets("EU IMAC").Range("B25").Value & " - Deployed -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
ActiveWorkbook.SaveAs p & s_name
'verwijderen
d_name = Sheets("EU IMAC").Range("B25").Value & " - Return to stock -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
If MsgBox("Are you sure that you want to remove " & d_name & " from the system?", vbQuestion + vbYesNo, "Sure?") = vbYes Then Kill p & d_name
End Sub
First, give your buttons meaningful names, that is such a garbled mess to try and determine what button60 is or does.
Second You need to use the file system object from Microsoft Scripting Library (add a reference in excel to this dll scrrun.dll) then you can check to see if the file exists and delete it
Sub Button61_Click()
p = "C:\Users\rjbakkex\Documents\Assets_logging\Deployed\"
'opslaan
s_name = Sheets("EU IMAC").Range("B25").Value & " - Deployed -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
ActiveWorkbook.SaveAs p & s_name
'verwijderen
d_name = Sheets("EU IMAC").Range("B25").Value & " - Return to stock -" & Format(Date, "yyyy-mm-dd") & ".xlsm"
'create the file system object
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'make sure the file exists first
If fso.FileExists(p & d_name) = True Then
If MsgBox("Are you sure that you want to remove " & d_name & " from the system?", vbQuestion + vbYesNo, "Sure?") = vbYes Then
fso.DeleteFile p & d_name, True
End If
End If
'free the memory
Set fso = Nothing
End Sub