I want to open a PDF file and print the subaddress that i specified, but when i use Application.SendKeys "(%{1068})" just print screen Userform. My issue is how print screen just subaddress Rating Changes.
enter code here
Private Sub AlteraRating_Click()
Dim strFolde As String, Month As String, Year As String, strFile As String
Month = Format(SalvaData, "mm")
Year = Format(SalvaData, "yyyy")
pdfData = Format(SalvaData, "yyyymmdd")
strFolder = "C:\Report\Report of Investments\" & Year & "\" & Month & "\"
strFile = strFolder & "RAI_INFRAPREV PLANO CV_F03148_" & pdfData & ".pdf"
ThisWorkbook.FollowHyperlink strFile, "Rating Changes"
Application.SendKeys "(%{1068})"
DoEvents
End Sub
Try using the following code in order to open the PDF, FollowHyperlink won't keep it open long enough to print screen.
Dim shell As Object
Set shell = CreateObject("WScript.Shell")
shell.Run Chr(34) & strFile & Chr(34), 1, False
Related
Yesterday we have finalized and tested the code (the first part of the code is VBScript) and the second part of the code is (in Excel VBA) to move file from one source folder to one destination folder successfully based on two hour delay (i.e. each file which will come to source folder will upload 2 hour delay), however the situation is that i have actually 15 source folders and 15 destination folders.
One method is that i should create 15 VBScript files and 15 Excel files that contains the code for each source and destination folder which i believe is not efficient way. I have tried a lot to add multiple source and destination folder options in the below mentioned code(s) but i am not successful, can anyone help me, i will be thankful.
the below mentioned code is VBscript
Dim oExcel, strWB, nameWB, wb
strWB = "E:\Delta\Folder monitor.xlsm"
nameWB = Left(strWB, InStr(StrReverse(strWB), "\") - 1)
nameWB = Right(strWB, Len(nameWB))
Set objExcel = GetObject(,"Excel.Application")
Set wb = objExcel.Workbooks(nameWB)
if wb is nothing then wbscript.quit 'the necessary workbook is not open...
dim strComputer, strDirToMonitor, strTime, objWMIService, colMonitoredEvents, objEventObject, MyFile
strComputer = "."
'# WMI needs two backslashes (\\) as path separator and each of it should be excaped.
'# So, you must use 4 backslashes (\\\\) as path separator!
strDirToMonitor = "E:\\\\Delta\\\\Source" 'use here your path
'# Monitor Above every 10 secs...
strTime = "10"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN " & strTime & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=" & Chr(34) & strDirToMonitor & Chr(34) & "'")
Do While True
Set objEventObject = colMonitoredEvents.NextEvent()
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
' msgbox "OK"
'MsgBox "A new file was just created: " & _
MyFile = StrReverse(objEventObject.TargetInstance.PartComponent)
'// Get the string to the left of the first \ and reverse it
MyFile = (StrReverse(Left(MyFile, InStr(MyFile, "\") - 1)))
MyFile = Mid(MyFile, 1, Len(MyFile) - 1)
'send the information to the waiting workbook:
objExcel.Application.Run "'" & strWB & "'!GetMonitorInformation", Array(MyFile,Now)
End Select
Loop
and the second code for this purpose should be copied in a standard module:
Option Explicit
Private Const ourScript As String = "FolderMonitor.vbs"
Private Const fromPath As String = "E:\Delta\Source\"
Sub startMonitoring()
Dim strVBSPath As String
strVBSPath = ThisWorkbook.Path & "\VBScript\" & ourScript
TerminateMonintoringScript 'to terminate monitoring script, if running..
Shell "cmd.exe /c """ & strVBSPath & """", 0
End Sub
Sub TerminateMonintoringScript()
Dim objWMIService As Object, colItems As Object, objItem As Object, Msg
As String
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", 48)
For Each objItem In colItems
If objItem.Caption = "wscript.exe" Then
'// msg Contains the path of the exercutable script and the script name
On Error Resume Next
Msg = objItem.CommandLine 'for the case of null
On Error GoTo 0
'// If wbscript.exe runs the monitoring script:
If InStr(1, Msg, ourScript) > 0 Then
Debug.Print "Terminate Wscript process..."
objItem.Terminate 'terminate process
End If
End If
Next
Set objWMIService = Nothing: Set colItems = Nothing
End Sub
Sub GetMonitorInformation(arr As Variant)
'call DoSomething Sub after 2 hours (now IT WILL RUN AFTER 1 MINUTE, for testing reasons...)
'for running after 2 hours you should change "00:01:00" in "02:00:00":
arr(0) = Replace(arr(0), "'", "''") 'escape simple quote (') character'
Application.OnTime CDate(arr(1)) + TimeValue("00:01:00"), "'DoSomething """ & CStr(arr(0)) & """'"
Debug.Print "start " & Now 'just for testing (wait a minute...)
'finaly, this line should be commented.
End Sub
Sub DoSomething(strFileName As String)
Const toPath As String = "E:\Delta\Destination\"
If Dir(toPath & strFileName) = "" Then
Name fromPath & strFileName As toPath & strFileName
Debug.Print strFileName & " moved from " & fromPath & " to " & toPath 'just for testing...
Else
MsgBox "File """ & toPath & strFileName & """ already exists in this location..."
End If
End Sub
you can see the previous query here on the link Previous Query
Please, use the next scenario. It assumes that you will fill the necessary path in an existing Excel sheet. Since, it will take the necessary paths based on a cell selection, it is necessary to name the sheet in discussion as "Folders". In Column A:A you should fill the 'Source' folder path (ending in backslash "") and in B:B, the 'Destination' folder path (also ending in backslash).
The proposed solution takes the necessary paths based on your selection in A:A column. The 'Destination' path is extracted based on the selection row.
Please, replace the existing string with the next one, adapting the two necessary paths:
Dim oExcel, strWB, nameWB, wb
strWB = "C:\Teste VBA Excel\Folder monitor.xlsm" 'use here your workbook path!!!
nameWB = Left(strWB, InStr(StrReverse(strWB), "\") - 1)
nameWB = Right(strWB, Len(nameWB))
Set objExcel = GetObject(,"Excel.Application")
Set wb = objExcel.Workbooks(nameWB)
if wb is nothing then wbscript.quit 'the necessary workbook is not open...
dim strComputer, strDirToMonitor, strTime, objWMIService, colMonitoredEvents, objEventObject, MyFile
strComputer = "."
'# WMI needs two backslashes (\\) as path separator and each of it should be excaped.
'# So, you must use 4 backslashes (\\\\) as path separator!
strDirToMonitor = "C:\\\\test\\\\test" 'use here your path !!!
'# Monitor Above every 10 secs...
strTime = "10"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN " & strTime & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=" & Chr(34) & strDirToMonitor & Chr(34) & "'")' and " _
' & "'Win32_Directory.Name=" & Chr(34) & strDirToMonitor & Chr(34) & "'")
Do While True
Set objEventObject = colMonitoredEvents.NextEvent()
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
MyFile = StrReverse(objEventObject.TargetInstance.PartComponent)
' Get the string to the left of the first \ and reverse it
MyFile = (StrReverse(Left(MyFile, InStr(MyFile, "\") - 1)))
MyFile = Mid(MyFile, 1, Len(MyFile) - 1)
'send the information to the waiting workbook:
objExcel.Application.Run "'" & strWB & "'!GetMonitorInformation", Array(MyFile, Now, strDirToMonitor)
End Select
Loop
The adapted script sends also the source path to the waiting workbook...
TerminateMonintoringScript Sub remains exactly as it is.
Please, copy the next adapted code instead of existing one, in the used standard module (TerminateMonintoringScript included, even not modified):
Option Explicit
Private Const ourScript As String = "FolderMonitor.vbs"
Private fromPath As String, toPath As String
Sub startMonitoring()
Dim strVBSPath As String, actCell As Range, strTxt As String, pos As Long, endP As Long, oldPath As String
Set actCell = ActiveCell
If actCell.Parent.Name <> "Folders" Then MsgBox "Wrong activated sheet...": Exit Sub
fromPath = actCell.Value
If actCell.Column <> 1 Or Dir(fromPath, vbDirectory) = "" Then Exit Sub 'not a valid path in the selected cell
strVBSPath = ThisWorkbook.Path & "\VBScript\" & ourScript
'change the script necessary "strDirToMonitor" variable path, if the case:__________________________
strTxt = ReadFile(strVBSPath)
pos = InStr(strTxt, Replace(fromPath, "\", "\\\\"))
If pos = 0 Then 'if not the correct path already exists
pos = InStr(strTxt, "strDirToMonitor = """) 'start position of the existing path
endP = InStr(strTxt, """ 'use here your path") 'end position of the existing path
'extract existing path:
oldPath = Mid(strTxt, pos + Len("strDirToMonitor = """), endP - (pos + Len("strDirToMonitor = """)))
strTxt = Replace(strTxt, oldPath, _
Replace(Left(fromPath, Len(fromPath) - 1), "\", "\\\\")) 'replacing existing with the new one
'drop back the updated string in the vbs file:
Dim iFileNum As Long: iFileNum = FreeFile
Open strVBSPath For Output As iFileNum
Print #iFileNum, strTxt
Close iFileNum
End If
'__________________________________________________________________________________________________
TerminateMonintoringScript 'to terminate monitoring script, if running...
Application.Wait Now + TimeValue("00:00:02") 'to be sure that the next line will load the updated file...
Shell "cmd.exe /c """ & strVBSPath & """", 0 'run the VBScript
End Sub
Function ReadFile(strFile As String) As String 'function to read the vbscript string content
Dim iTxtFile As Integer
iTxtFile = FreeFile
Open strFile For Input As iTxtFile
ReadFile = Input(LOF(iTxtFile), iTxtFile)
Close iTxtFile
End Function
Sub TerminateMonintoringScript()
Dim objWMIService As Object, colItems As Object, objItem As Object, Msg As String
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", 48)
For Each objItem In colItems
If objItem.Caption = "wscript.exe" Then
'// msg Contains the path of the exercutable script and the script name
On Error Resume Next
Msg = objItem.CommandLine 'for the case of null
On Error GoTo 0
'// If wbscript.exe runs the monitoring script:
If InStr(1, Msg, ourScript) > 0 Then
Debug.Print "Terminate Wscript process..."
objItem.Terminate 'terminate process
End If
End If
Next
Set objWMIService = Nothing: Set colItems = Nothing
End Sub
Sub GetMonitorInformation(arr As Variant)
'call DoSomething Sub after 2 hours (now IT WILL RUN AFTER 1 MINUTE, for testing reasons...)
'for running after 2 hours you should change "00:01:00" in "02:00:00":
arr(0) = Replace(arr(0), "'", "''") 'escape simple quote (') character'
fromPath = Replace(arr(2), "\\\\", "\")
Dim rngFrom As Range: Set rngFrom = ThisWorkbook.Sheets("Folders").Range("A:A").Find(what:=fromPath)
toPath = rngFrom.Offset(, 1).Value
Application.OnTime CDate(arr(1)) + TimeValue("00:00:30"), "'DoSomething """ & fromPath & "\" & CStr(arr(0)) & """, """ & toPath & CStr(arr(0)) & """'"
Debug.Print Now; " start " & arr(0) & fromPath & "\" & CStr(arr(0)) 'just for testing (wait a minute...)
'finaly, this line should be commented.
End Sub
Sub DoSomething(sourceFileName As String, destFilename As String)
If Dir(destFilename) = "" Then
Name sourceFileName As destFilename
Debug.Print sourceFileName & " moved to " & destFilename 'just for testing...
Else
Debug.Print "File """ & destFilename & """ already exists in this location..."
End If
End Sub
Sub DoSomething_(strFileName As String) 'cancelled
If Dir(toPath & strFileName) = "" Then
Name fromPath & strFileName As toPath & strFileName
Debug.Print strFileName & " moved from " & fromPath & " to " & toPath 'just for testing...
Else
MsgBox "File """ & toPath & strFileName & """ already exists in this location..."
End If
End Sub
So, you only need to replace the existing VBA code with the above adapted one, to place the 'source'/'destination' paths in columns A:B of one of Excel sheets, which to be named "Folders".
Select in column A:A a 'Source' cell and run startMonitoring.
Play with files creation and check their moving from the new 'source' to the new 'destination'...
But you have to understand that only a session of the WMI class can run at a specific moment. This means that you cannot simultaneously monitor more than one folder...
I am still documenting regarding the possibility to use a query able to be common for multiple folders. But I never could see such an approach till now and it may not be possible...
Some of VBA Experts have helped me a lot and have fixed the code for me which moves one file one at a time but it first moves the oldest file in the folder. However here i have a complex situation which for now not resolving. i.e. I would like to add a timer of two hours i.e. the file should move after two hour.
e.g. If a file named "North_West data" whose modified time is 6:40 PM i would like the code to move it exactly after two hours. Similarly at the next run the next file which has to be moved has filed modified time e.g. 6:50 PM so the VBA code should actually move it exactly after two hours. this means each file should have automatic two hours delay timer in it, i hope i am able to clarify the query.
Function OldestFile(strFold As String) As String
Dim FSO As Object, Folder As Object, File As Object, oldF As String
Dim lastFile As Date: lastFile = Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(strFold)
For Each File In Folder.Files
If File.DateLastModified < lastFile Then
lastFile = File.DateLastModified: oldF = File.Name
End If
Next
OldestFile = oldF
End Function
Sub MoveOldestFile()
Dim FromPath As String, ToPath As String, fileName As String
FromPath = "E:\Source\"
ToPath = "E:\Destination\"
fileName = OldestFile(FromPath)
If Dir(ToPath & fileName) = "" Then
Name FromPath & fileName As ToPath & fileName
Else
MsgBox "File """ & fileName & """ already moved..."
End If
End Sub
You can check the previously resolved query here
Previous query
Please, try the next way. Basically, it uses a VBScript able to catch file creation event, which sends the created file name and the moment of creation to a workbook which should be open all the time.
Create a VBScript and name it "FolderMonitor.vbs". To do that, please copy the next code in an empty Notepad window:
Dim oExcel, strWB, nameWB, wb
strWB = "C:\Teste VBA Excel\Folder monitor.xlsm" 'use here the path of the waiting workbook!
nameWB = Left(strWB, InStr(StrReverse(strWB), "\") - 1)
nameWB = Right(strWB, Len(nameWB))
Set objExcel = GetObject(,"Excel.Application")
Set wb = objExcel.Workbooks(nameWB)
if wb is nothing then wbscript.quit 'the necessary workbook is not open...
dim strComputer, strDirToMonitor, strTime, objWMIService, colMonitoredEvents, objEventObject, MyFile
strComputer = "."
'# WMI needs two backslashes (\\) as path separator and each of it should be excaped.
'# So, you must use 4 backslashes (\\\\) as path separator!
strDirToMonitor = "C:\\\\test\\\\test" 'use here your path
'# Monitor Above every 10 secs...
strTime = "10"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN " & strTime & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=" & Chr(34) & strDirToMonitor & Chr(34) & "'")
Do While True
Set objEventObject = colMonitoredEvents.NextEvent()
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
MyFile = StrReverse(objEventObject.TargetInstance.PartComponent)
' Get the string to the left of the first \ and reverse it
MyFile = (StrReverse(Left(MyFile, InStr(MyFile, "\") - 1)))
MyFile = Mid(MyFile, 1, Len(MyFile) - 1)
'send the information to the waiting workbook:
objExcel.Application.Run "'" & strWB & "'!GetMonitorInformation", Array(MyFile,Now)
' some other events can be used starting from here...
End Select
Loop
And save it as stated above. But take care to not save it as "FolderMonitor.vbs.txt". In order to avoid that, when saving you should change 'Save as typefrom defaultText documents (.txt)toAll files (.*)`!
In order to make the following code working as it is, you should create a folder named "VBScript" in the folder where the workbook running the code exists and place the above VBScript inside!
Copy the next code in a standard module of a xlsm workbook. In order to be called by the above script, as it is, you should name it "Folder monitor.xlsm":
Option Explicit
Private Const ourScript As String = "FolderMonitor.vbs"
Private Const fromPath As String = "E:\Source\"
Sub startMonitoring()
Dim strVBSPath As String
strVBSPath = ThisWorkbook.Path & "\VBScript\" & ourScript
TerminateMonintoringScript 'to terminate monitoring script, if running..
Shell "cmd.exe /c """ & strVBSPath & """", 0
End Sub
Sub TerminateMonintoringScript()
Dim objWMIService As Object, colItems As Object, objItem As Object, Msg As String
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", "WQL", 48)
For Each objItem In colItems
If objItem.Caption = "wscript.exe" Then
'// msg Contains the path of the exercutable script and the script name
On Error Resume Next
Msg = objItem.CommandLine 'for the case of null
On Error GoTo 0
'// If wbscript.exe runs the monitoring script:
If InStr(1, Msg, ourScript) > 0 Then
Debug.Print "Terminate Wscript process..."
objItem.Terminate 'terminate process
End If
End If
Next
Set objWMIService = Nothing: Set colItems = Nothing
End Sub
Sub GetMonitorInformation(arr As Variant)
'call DoSomething Sub after 2 hours (now IT WILL RUN AFTER 1 MINUTE, for testing reasons...)
'for running after 2 hours you should change "00:01:00" in "02:00:00":
arr(0) = Replace(arr(0), "'", "''") 'escape simple quote (') character'
Application.OnTime CDate(arr(1)) + TimeValue("00:01:00"), "'DoSomething """ & CStr(arr(0)) & """'"
Debug.Print "start " & Now 'just for testing (wait a minute...)
'finaly, this line should be commented.
End Sub
Sub DoSomething(strFileName As String)
Const toPath As String = "E:\Destination\"
If Dir(toPath & strFileName) = "" Then
Name fromPath & strFileName As toPath & strFileName
Debug.Print strFileName & " moved from " & fromPath & " to " & toPath 'just for testing...
Else
MsgBox "File """ & toPath & strFileName & """ already exists in this location..."
End If
End Sub
a. You firstly should run "startMonitoring" Sub. It can be called from the Workbook_Open event.
b. Copy files in the monitored folder and check if they are copied as it should. Note that the code as it is move it after a minute. It is commented to exactly show what and how it can be changed...
I am using an excel vba project to create an word file then saving it to pdf using following code.
wordapp.ActiveDocument.SaveAs2 "" & folder & "" & pdfname & ".pdf", 17
I want to print the same word file using PDF printer at path of
& folder &
and filename as
& pdfname &
I have tried using this as a macro in word file but it asks for a path and filename. Does not automate it.
Probably the easiest way is to use the pdfName as a string and to put a \ sign before it and the folder.
Try to run this code from Excel file, just make sure that the Excel file is saved successfully, otherwise ThisWorkbook.Path would be equl to empty string and you will be asked to save the file during runtime -> If ThisWorkbook.Path = vbNullString Then ThisWorkbook.Save
Public Sub TetMe()
Dim wordApp As Object
Dim WordDoc As Object
Dim folder As String
Dim pdfName As String: pdfName = "someName"
If ThisWorkbook.Path = vbNullString Then ThisWorkbook.Save
Set wordApp = CreateObject("Word.Application")
Set WordDoc = wordApp.documents.Add
folder = ThisWorkbook.Path & "\"
wordApp.ActiveDocument.SaveAs2 folder & pdfName & ".pdf", 17
End Sub
If you are wondering what 17 after .SaveAs2 is, it is wdSaveFormat Enumeration for wdFormatPDF.
WdSaveFormat Enumeration MSDN
Following Code can be used to make Foxit PDF Printer run for your code.
MAIN CODE
ActivePrinter = "Foxit Reader PDF Printer"
printoutcommand = "wordapp.ActiveDocument.PrintOut
Range:=wdPrintAllDocument, PrintToFile:=True,OutputFilename:=" & sItem &
pdfname & "_temp" & ".pdf"
wordapp.Application.Run "FoxitPrint2PDF"
Application.Wait (Now + TimeValue("0:00:02"))
Name "C:\Users\shena\Documents\Document1.pdf" As pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
FileCopy "C:\Users\shena\Documents\" & pdfname & "_temp" & ".pdf", sItem & "" & pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
Kill "C:\Users\shena\Documents\" & pdfname & "_temp" & ".pdf"
Application.Wait (Now + TimeValue("0:00:02"))
wordapp.activedocument.Close SaveChanges:=wdDoNotSaveChanges
wordapp.Quit
Set wordapp = Nothing
FoxitPrint2PDF is macro used to set Foxit PDF Printer as default printer and then reset it. Code is as follows
Dim sCurrentPrinter As String
On Cancel GoTo Cancelled:
sCurrentPrinter = ActivePrinter
ActivePrinter = "Foxit Reader PDF Printer"
Application.PrintOut FileName:=""
Cancelled:
ActivePrinter = sCurrentPrinter
Its just an idea given same code can be written in a module where print operation is going on.
In main code some cut paste operations are seen. Here is the explanation of the same. When we select PDF as a printer we have selected a default location for converted PDF. from that location we are taking it to our desired location. You can see those option at right click on "Foxit Reader PDF Printer" then click on Printing Preferences. Screen shot of the same is given below for reference.
Highlighted options are important for us.
With no coding knowledge, I have attempted to use some code found here: Automatically name a file based on cell data when saving a spreadsheet?. Thanks to Jean-François Corbett
I have adapted as follows to show the dialog box:
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
strFolderPath = "N:\PROJECTS\"
strPath = strFolderPath & _
Sheet1.Range("B2").Value & "_" & _
Sheet1.Range("B6").Value & "_" & _
Sheet1.Range("X1").Value & "-JS-1" & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show strPath
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
I am opening an .xltm file, and attempting to save with the ability to select the subfolder of N:\PROJECTS\ with the combination of cell references shown.
The dialog box appears fine, already showing N:\PROJECTS. However, it does not fill the file name, unless the file is first saved as a .xlsm. It then always attempts to overwrite as well.
This worked for me, utilizing a slightly different code technique.
Option Explicit
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
ChDir "N:\PROJECTS\" 'set directory with this line
With Sheet1
strPath = .Range("B2").Value
strPath = strPath & "_" & .Range("B6").Value
strPath = strPath & "_" & .Range("X1").Value
strPath = strPath & "-JS-1.xlsm"
End With
Application.Dialogs(xlDialogSaveAs).Show strPath 'load file name with this argument
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
The main issue remaining was that opening from a template didn't automatically save as .xlsm. Apparently Application.Dialogs doesn't support file filters, so the problem is better solved with GetSaveasFileName.
Full code as follows:
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
strFolderPath = "N:\PROJECTS\"
strPath = strFolderPath & _
Sheet1.Range("B2").Value & "_" & _
Sheet1.Range("B6").Value & "_" & _
Sheet1.Range("X1").Value & "-JS-1" & ".xlsm"
fileSaveName = Application.GetSaveAsFilename(strPath _
, fileFilter:="Excel Files (*.xlsm), *.xlsm")
End Sub
It is supposed to save as file name: Folder\test location 'what ever is in cell C27' and then data and time. I am getting :'008 11 2015 00 00 00'. How do I clean this up with out using "/" and ":"? Note the first 0 is just the test number I used.
Also this macro is in a template that the Testing software uses that is why it has to use Auto_open but the other problem is that when it saves as a non template file, upon opening it tries to run the macro in the non template file. How can I make it so the macro does not save in or is disabled in the save as files/ non template files?
Sub Auto_Open()
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
MyNote = "Is Cell 'C27' Overview Information" & SavePath & " Location_1,2,3,or 4?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("C27").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("C27").Text
FileDate = Format(Date, "mm dd yyyy hh mm ss")
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FileDate
MsgBox "File was saved!"
MyNote = "Open FRF Data Sheet?(After Forth Test Only)"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
Workbooks.Open ("FRF_Data_Sheet_Template.xlsm")
Else
MsgBox "Ready for Next Test, Please Exit."
End If
Else
MsgBox "File was not saved, Please Use Location_1,2,3or,4 Durring SIG ATM Test"
End If
End Sub
Solved:
Sub Auto_Open()
With Range("A30")
.Value = Time
.NumberFormat = "h-mm-ss AM/PM"
End With
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
MyNote = "Is Cell 'B27' Overview Information" & SavePath & " Location1,2,3,or 4?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("C27").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
Dim FileTime As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("B27").Text
FileTime = Sheets("Data").Range("A30").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FileTime & ".xlsx", FileFormat:=xlOpenXMLWorkbook
MsgBox "File was saved!"
MsgBox "Ready for Next Test, Please Exit."
Else
MsgBox "File was not saved, Please Use Location_1,2,3or,4 Durring SIG ATM Test"
End If
End Sub
You can't have a \ in a filename.
For the date part, use the format function. You can define the date format if you want by using "MM-dd-yyy"
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & Format(FileDate, "MM-dd-yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Use the FileFormat:=xlOpenXMLWorkbook to save it as a workbook without macros.