I'm trying to open all MS Project files in a specific folder to extract some information of each one and transfer to excel.
Sub OpenProjectFiles()
Dim myMpp As MSProject.Application
Dim FileNameMpp As String, Folder As String
Folder = "C:\Users\nikolasqueiroz\Desktop\VBA Test"
Set myMpp = CreateObject("Msproject.Application")
FileNameMpp = Dir(Folder & "\*.mpp")
Do
myMpp.FileOpenEx Name:=FileNameMpp, ReadOnly:=True
FileNameMpp = Dir
Loop Until FileNameMpp = " "
End Sub
But when I try to open the .mpp file something goes wrong:
Does anyone know how can I fix this?
First of all, the code you posted does not match the code shown in your screenshot. The screenshot code uses the syntax for opening files from Project Server--e.g. prefacing the name of the file with <>\.
Use this code instead:
Sub OpenProjectFiles()
Dim myMpp As MSProject.Application
Dim FileNameMpp As String, Folder As String
Folder = "C:\Users\nikolasqueiroz\Desktop\VBA Test\"
Set myMpp = CreateObject("Msproject.Application")
myMpp.Visible = True
FileNameMpp = Dir(Folder & "*.mpp")
Do While Len(FileNameMpp) > 0
myMpp.FileOpenEx Name:=Folder & FileNameMpp, ReadOnly:=True
FileNameMpp = Dir
Loop
End Sub
Notes:
When automating another application, make it visible so you can see & respond to pop-up messages.
The FileOpenEx method should be given the full path.
Test the output of the Dir function at the beginning of the loop as there may not be any files.
Adding the trailing slash in the Folder variable is simpler & cleaner than adding it later (in two places).
Related
I am new to VBA. I am using a "shell" macro to run another macro on a series of files. It won't save. I am going to include my code here and also a series of photos because the photos were the only way to show the result of hovering over the values in the code.
So, the error message is generating something I don't understand. But it is clear that the links in the code link to what the results should be, so I'm confused.
This is the code:
Sub SHELLforMacros()
Dim wbMatrix As Workbook
Dim strFileName As String
Dim strFileName As String
Dim newFileName As String
Dim strPath As String
Dim strExt As String
Dim objWorkbook As Workbook
Dim ws As Worksheet
Dim Sheetname As Worksheet
Set Sheetname = Worksheets(1)
Dim Worksheet As Worksheet
Dim rng As Range
Set rng = Range("A2")
strPath = "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\test\"
strExt = "csv"
strFileName = Dir(strPath & "*." & strExt)
While strFileName <> ""
Set wbMatrix = Workbooks.Open(strPath & strFileName)
Application.Run "'C:\Users\myname\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB'!Graph_NEW"
strPath = "C:\Users\myname\All_mricgcm3_files\45\Fall45\test\"
newFileName = Sheetname.Range("A2").Value
ActiveWorkbook.SaveAs fileName:=strPath & newFileName, FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Wend
End Sub
What this macro is supposed to do is open a file, run another macro on the file (creating a graph), and then save the file with the same name but as an .xlsx file. Then open the next file in the folder and do the same, until it runs out of files. I realize the code may not be the most current. It is cobbled together from things I've found online. Thanks for any help.
Edit: UPDATE - I removed all the section on saving and closing the file from the "shell" macro and put it into the "Graph_NEW" macro. Now the "shell" macro is running fine. But I am running into the same issue with the "Graph_NEW" macro now. It is exactly the same error message as highlighted in the first image, only each time there is a new 8-digit alphanumeric "filename" that it is looking for. This seems like a very specific thing.
I changed the section in the following ways, successively, in an attempt to debug. I added With and End With around the section:
With WB
ActiveWorkbook.Save
newFileName = Sheetname.Range("A2").Value
strPath = "C:\Users\qmontana\All_mricgcm3_files\mric45\Fall45\test\"
ActiveWorkbook.SaveAs fileName:=strPath & newFileName & ".xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
End With
I changed the name of the folder from "45" to "mric45" thinking that maybe it didn't like a number as a folder name.
I removed the "backslash" at the end of the strPath--and then the 8-digit alphanumeric string showed up as an error after the Fall45 folder, like this "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\777GTY78". Yet, as I've shown in the images, all indications are that it knows what file it is working with. There are no "blank spaces" in the pathname.
I tried taking the underscores out of the folder "All_mricgcm3_files".
I moved the line newFileName = Sheetname.Range("A2").Value to come before the strPath line.
Where is this 8-digit alphanumeric "filename" coming from?? (See error code, first image.)
Ok, it was a very simple thing, in case anyone else runs into this problem.
Took me two days to find out though --> I had somehow dropped a folder layer in the path name. The catch? The alphanumeric string was showing up at the end of the path name, not where the folder layer was missing. That's why I was thrown off because my focus was on the ending.
When I added that folder\ back in, I had no more problem with saving and the macro ran fine.
I need a macro to automatically loop through files in a folder and copy certain values from these files. I have the copy part setup on manually selected files, but need to now automatically select them.
I already have a macro setup to loop through multiple files that the user selects. Except now, I'm trying to run it automatically and would like the macro to autoselect any files in a specified directory. How do I specify this directory? I've included my current code for manual selection.
Edit: I tried implementing the below answer, but I recieve an error saying that the file list is not in the format of an array. How do I overcome this?
FileNames = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*;*.csv*", MultiSelect:=True)
ii = 1
Do While ii <= UBound(FileName)
Set wbk = Workbooks.Open(FileName(ii))
'Multiple Loops
Wend
Maybe try :
Sub GetAllFileNames()
Dim FolderName As String
Dim FileName As String
FolderName = "C:\Users\sumit\Desktop\Test\" 'change your path
FileName = Dir(FolderName & "*.xls*") 'this one will browse only .xls if you want to browse all file see the note
Do While FileName <> ""
Debug.Print FileName
FileName = Dir()
Loop
End Sub
Note : FileName = Dir(FolderName) will browse you all files in folder.
If the the workbook is in the same folder than the file you want to browse you can select path like this :
FolderName = Application.ActiveWorkbook.Path & "\"
I'm trying to better understand the Dir function. I have a Dir loop to take action on all .csv files in the directory, but when the loop comes across another file type, like .txt, it will error instead of moving on to the next .csv. item.
This is the relevant portion of my code.
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
strWorkbook = Dir(strSourceExcelLocation & "*.csv*")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
So if there are only .csv files in the directory, then this works fine. When it comes across another file type, an error occurs.
The error is on line
strWorkbook = Dir
Run-time error 5: Invalid procedure call or argument
Am I missing something with the way I use the wildcards in the .csv at the beginning?
Thank you
Solved my issue.
The problem seems to have been because when I called another procedure, I had another Dir in that sub to create a new folder if one didn't already exist. So basically I had a Dir in a Dir, which apparently is bad.
I moved the folder creation part to the very beginning of my procedure, so it is executed before I begin the Dir for looping through all the CSV files.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String, wbktoExport As Workbook, strSourceExcelLocation As String, fldr As String, strTargetPDFLocation As String, d As String
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\"
'***** Creating a folder to save the PDFs in. Naming the folder with today's date *****
d = Format(Date, "mm-dd-yyyy")
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\" & d & "\"
If Len(Dir(strTargetPDFLocation, vbDirectory)) = 0 Then MkDir strTargetPDFLocation
fldr = InputBox("Input the EXACT Folder Name that you want to create PDFs for")
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.csv")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport, strTargetPDFLocation)
'Close Excel workbook without making changes
wbktoExport.Close False
'Get next workbook
strWorkbook = Dir
Loop
End Sub
Try to hardcode the path and give it a try again. Probably the error is something really small in the hardcoding. E.g., in the code below, replace C:\Users\username\Desktop\AAA\ with the path of the file. Then run it. Do not forget the last \. It should work:
Sub TestMe()
Dim workbookPath As String
workbookPath = Dir("C:\Users\username\Desktop\AAA\" & "*.csv")
Do While Len(workbookPath) > 0
Debug.Print workbookPath
workbookPath = Dir
Loop
End Sub
Since I am very new to the excel macro I am trying to develop a code which is able to open the PDF file.But There are some PDF files in my system which are generated by another system therefore those files names change day by day and some figures are included too.
As an example,"Process Report 151120183569844" like this.These figures change everyday.I tried it with adding WILDCARD option but it doesn't work.How do I open this PDF with only a part of the file name?
Sub Open_PDF()
Dim pdfPath As String
pdfPath ="D:\Reports\Process Report*" & ".pdf" 'I used wildcard instead "Process Report 151120183569844"'
Call OpenAnyFile(pdfPath)
End Sub
Function openAnyFile(strPath As String)
Set objShell = CreateObject("Shell.Application")
objShell.Open(strPath)
End Function
As pointed out in another answer, the Dir function with a wildcard should do the trick.
Here's an example using the original openAnyFile function.
Sub Open_PDF()
Dim filePath As String, fileName As String
filePath = "D:\Reports\"
fileName = Dir(filePath & "Process Report*.pdf")
If fileName <> "" Then
openAnyFile filePath & fileName
End If
End Sub
Function openAnyFile(strPath As String)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open (strPath)
End Function
You cannot open a file using a wildcard - it's just common sense, what if more than one file was matching your criteria - which one would you want to program to open? You have to specify the exact file name to open it.
if there is just one file in the target directory, you can use something like the following code to open it, regardless of its name:
sFound = Dir(ActiveWorkbook.Path & "\Process Report*.xlsm")
If sFound <> "" Then
Workbooks.Open filename:= ActiveWorkbook.Path & "\" & sFound
End If
I am trying to find the command and correct coding to open a PDF file with a relative file path to the active excel file. The code below works fine as a link directly to the file. However, I just need this code snippet to find the PDF file that is sitting in the same file as the opened excel file and open accordingly.
Sub OpeningPDF()
'ThisWorkbook.FollowHyperlink "C:\Users\Michael\My Documents\totals\copy.pdf"
End Sub
I tried working with ThisWorkbook.path but nothing I tried with that worked or seemed to be outdate. Any help in this matter would be much appreciated.
I have found two solutions to this:
The first one is using the built-in Shell() function. This should automatically resolve the relative path (relative to the applications current working directory):
Public Sub StartExeWithArgument()
Dim strFilename As String
strFilename = "../folder/file.pdf"
Call Shell(strFilename, vbNormalFocus)
End Sub
The second one uses the Shell.Application COM Object and will basically do the same as the first one.
Sub runit()
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
tgtfile = "../folder/file.pdf"
Shex.Open (tgtfile)
End Sub
If you start with ThisWorkbook.Path and your relative-reference, then trim a layer off for every "..\" in the relative reference, you'll get the path.
Function RelativeToAbsolutePath(ByVal RelativePath As String) AS String
Dim TempStart AS String, TempEnd AS String
TempStart = ThisWorkbook.Path
TempEnd = RelativePath
If Left(TempEnd,1) = "\" Then TempEnd = Mid(TempEnd,1)
RelativeToAbsolutePath = ""
On Error GoTo FuncErr
While Left(TempEnd,3)="..\" AND InStrRev(TempStart,"\")>0
TempStart = Left(TempStart,InStrRev(TempStart,"\")-1) 'Remove 1 layer from Workbook path
TempEnd = Mid(TempEnd,4) 'Remove 1 instance of "..\"
Wend
RelativeToAbsolutePath = TempStart & "\" & TempEnd 'Stitch it all together
FuncErr: 'You may want a DIR(..) check to see if the file actually exists?
End Function
You can then open it with Shell