Get only the PDF files - excel

I have a little problem with my code in VBA, How can I exclude the other extension file like .txt, .csv, .xlsx, and .xlsm so I can select only in my For Each Loop is the .PDF extension only.
I've already searched about this issue and already tried, But the solution is not applicable in my code.
This is my code:
Option Explicit
Sub GetPDFFile()
Dim mainWs As Worksheet
Dim pdfPath As Variant, excelPath As Variant
Dim fileSystemObject As New fileSystemObject
Dim getFolderPath As Folder
Dim getFile As file
Dim wb As Workbook
Set mainWs = ThisWorkbook.Sheets("Main")
pdfPath = mainWs.Range("C7").Value
excelPath = mainWs.Range("C8").Value
'Set all variable to null
Call SetNothing
If pdfPath = "" Then
Call MsgActionInvalid("Please input PDF File Folder.")
ElseIf excelPath = "" Then
Call MsgActionInvalid("Please input Output Folder Location.")
Else
Set getFolderPath = fileSystemObject.getFolder(pdfPath)
Set wa = CreateObject("word.application")
If cntFiles <> 0 Then
For Each getFile In getFolderPath.Files
`Other code............
Next
End Sub
I'm getting all the files inside the folder that I've selected. So inside the For Each Loop I'm getting a debug message because the file is not .PDF.
Any ideas about this guys?
Thanks in advance.

Use the Type property of the File object like getFile.Type to find out its type. And use a If statement to run your Other code............ only on the desired type of files.
Alternatively use UCase(getFile) Like "*.PDF" to make sure that it is not case sensitive. Otherwise you only trigger .PDF but not .Pdf or .pdf or .pDf or whatever.
Which is the same as UCase(Right$(getFile, 4)) = ".PDF"

You should be using Right to check the file extension. Something like:
For Each getFile In getFolderPath.Files
If Right(getFile, 4) = ".pdf" Then
' have found a PDF extension............
End If
Next
Regards,

Related

Is there a way to open a file once I have verified it exists?

Currently with the VBA code below, I'm able to successfully verify if a file, with the name "Test", exists or not. If it exists, it returns the entire name of the file. However, what I am trying to do is open that file I found. So far, the forums I have searched for provide explanations on opening a workbook or an excel file, but I am trying to open any type of file (such as .docx, .pdf or .txt and etc.)
Sub findFile()
Dim strFileName As String
Dim strFileExists As String
'name of the file I would like to find in C:\.
strFileName = "Test"
strFileExists = Dir(strFileName)
If strFileExists = "" Then
MsgBox "The file doesn't exist"
Else
MsgBox "The file does exist"
End If
End Sub
(Just so the answer doesn't stay blank, I'm expanding on my comment.)
In VBA, to launch a file, use the ShellExecute function. You can use this to start an application (exe) directly or open a file (pdf\txt\doc) using the default handler.
Here is sample code to open a PDF file using the default PDF application.
Dim objShell
Set objShell = CreateObject("shell.application")
objShell.ShellExecute "C:\Files\Project_V1.pdf", "", "", "open", 1
Set objShell = Nothing
Documentation can be found here:
https://learn.microsoft.com/en-us/windows/win32/shell/shell-shellexecute
You could try:
Sub test()
Dim strFile As String, strExist As String
Dim wb As Workbook
strFile = "C:\Users\pppp\Desktop\xxx\xxx.xlsx"
strExist = Dir(strFile)
'Check if exist
If strExist <> "" Then
'Open file
Set wb = Workbooks.Open(strFile)
End If
'Close file
wb.Close
End Sub

Open ZipFile, Look for Specific File Type And Save File Name

So I posted a question here:
VBA - Find Specific Sub Folders by Name Identifiers
This question was very broad, but I was facing specific issues I needed help identifying and resolving. Now, I managed to resolve those issues in the original post, however, there is still a good portion of the question unanswered and I would like to close the question only when I am able to post the full result.
Currently, what I still need to do, it the last 4 steps:
Open ZipFile
Look for .png extenstion
Grab the name of the .png file
Put the name in a cell in excel
The issue I am facing, is that of properly opening the zip file. I been through so many posts on this but NOTHING seems to work for me.
The closest I have come to accomplishing the task is what I found here:
https://www.ozgrid.com/forum/forum/help-forums/excel-general/109333-how-to-count-number-of-items-in-zip-file-with-vba-2007
I figure, if at the very least, I am able to enter the zip file, I can then work from there. But alas, I am still stuck at simply trying to open the file.
Here is the code I have (Using from the link above):
Sub CountZipContents()
Dim zCount As Double, CountContents As Double
Dim sh As Object, fld As Object, n As Object
Dim FSO As Object
CountContents = 0
zCount = 0
x = "C:\Users\UserName\Desktop\Today\MyFolder\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(x) Then
For Each FileInFolder In FSO.GetFolder(x).Files
If Right(FileInFolder.Name, 4) = ".png" Then
CountContents = CountContents + 1
ElseIf Right(FileInFolder.Name, 4) = ".Zip" Then
Set sh = CreateObject("Shell.Application")
Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
Debug.Print FileInFolder.Name
For Each fileInZip In ZipFile.Items
If LCase(fileInZip) Like LCase("*.png") Then
CountContents = CountContents + 1
End If
Next
End If
Next FileInFolder
End If
Set sh = Nothing
End Sub
The issue I get is on this line:
For Each fileInZip In ZipFile.Items
Error Message:
Object variable or With block not set
Whenever I tried to use Shell, like below:
Dim oShell As New Shell
I get this error:
User-defined type not defined
With the below:
Link https://msdn.microsoft.com/en-us/library/windows/desktop/bb776890(v=vs.85).aspx
Dim oApp As Object
Set oApp = CreateObject("WScript.Shell")
'get a shell object
Set oApp = CreateObject("Shell.Application")
If oApp.Namespace(ZipFile).Items.count > 0 Then
I get this error:
Object doesn't support this property or method
On this line:
If oApp.Namespace(ZipFile).Items.count > 0 Then
References to links I have tried:
https://wellsr.com/vba/2015/tutorials/open-and-close-file-with-VBA-Shell/
http://www.vbaexpress.com/forum/showthread.php?38616-quot-shell-quot-not-work-in-Excel
Excel VBA - read .txt from .zip files
I just don't understand why this step is taking so much time to complete.
Your main problem is a really simple one: Your path "C:\Users\UserName\Desktop\Today\MyFolder\" contains already a trailing backslash, and when you set your ZipFile-variable, you are adding another one between path and filename. This will cause the shell-command to fail and ZipFile is nothing.
There are some minor problems with the code. I would recommend to use the GetExtensionName of your FileSystemObject to get the extension and convert this to lowercase so that you catch all files, no matter if they are .PNG, .png or .Png
For Each FileInFolder In FSO.GetFolder(x).Files
Dim fileExt As String
fileExt = LCase(FSO.GetExtensionName(FileInFolder.Name))
If fileExt = "png" Then
CountContents = CountContents + 1
Debug.Print "unzipped " & FileInFolder.Name
ElseIf fileExt = "zip" Then
Dim ZipFileName As String, ZipFile, fileInZip
Set sh = CreateObject("Shell.Application")
ZipFileName = x & FileInFolder.Name
Set ZipFile = sh.Namespace(CVar(ZipFileName))
For Each fileInZip In ZipFile.Items
If LCase(FSO.GetExtensionName(fileInZip)) = "png" Then
CountContents = CountContents + 1
Debug.Print "zipped in " & FileInFolder.Name & ": " & fileInZip
End If
Next
End If
Next FileInFolder
Additionally the strong advice to use Option Explicit and define all your variables. And split commands into smaller pieces. This costs you only a few seconds of typing the extra lines but helps you when debugging your code:
' Instead of
' Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
' write
Dim fName as string
fName = x & "\" & FileInFolder.Name; ' Now you can check fName and see the problem.
Set ZipFile = sh.Namespace(CVar(fName))
Try this:
Option Explicit
' Just to test CheckZipFolder
Sub TestZip()
Dim sZipFold As String: sZipFold = "C:\Temp\MyZip.zip" ' Change this to the path to your zip file
CheckZipFolder sZipFold
End Sub
Sub CheckZipFolder(ByVal sZipFold As String)
Dim oSh As New Shell ' For this, you need to add reference to 'Microsoft Shell Controls and Automation'
Dim oFi As Object
' Loop through all files in the folder
For Each oFi In oSh.Namespace(sZipFold).Items
' Checking for file type (excel file in this case)
If oFi.Type = "Microsoft Excel Worksheet" Then
MsgBox oFi.Name
'..... Add your actions here
End If
' This will make the UDF recursive. Remove this code if not needed
If oFi.IsFolder Then
CheckZipFolder oFi.Path
End If
Next
' Clear object
Set oSh = Nothing
End Sub

How do you open a pdf file with VBA code for a relative file path?

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

How to get the file extension of the open workbook

How to determine if the open workbook is a template (.xltm) or not. Basically, I have a template. If the user opens the template as (right-click >open) as .xltm file and tries to run a macro, I should prevent a macro from being executed.
If the user double-clicks the template, it opens as .xlsm, in that case I have no issue.
Can someone please help me figure this out? Thanks in advance.
Regards,
you can use below example to get extension of file
Sub extd()
Dim extFind As String
Dim sFile As String
Const FilePath As String = "C:\Users\aa\Desktop\devces.docx"
sFile = Dir(FilePath & filename & "*")
extFind = Right$(sFile, Len(sFile) - InStrRev(sFile, "."))
MsgBox extFind
End Sub
I was looking for the same. Since ActiveWorkbook.Name depends on Windows property Hide extensions for known file types (If u have them hidden .Name wont return the extension), u can use Workbook.FileFormat. Returns an integer value, based on XlFileFormat enumeration. So, to check:
Option Explicit
Sub sample()
Debug.Print ActiveWorkbook.FileFormat
Select Case ActiveWorkbook.FileFormat
Case xlOpenXMLWorkbookMacroEnabled '52 xlsm
Debug.Print "Its a workbook with macros enabled"
Case xlOpenXMLTemplateMacroEnabled '53 xltm
Debug.Print "Its a template with macros enabled"
Case xlWorkbookDefault '51 xlsx
Debug.Print "Its a workbook without macros"
End Select
End Sub
Debug.Print Outputs to inmediate window, u can open it with Ctrl+G or in the view menu of the VB Editor.
Use the Code below:
'e.g. Active Workbook name = text.xlsx
Dim wk AS Workbook: Set wk = ActiveWorkbook
Dim fileExtension As String
fileExtension = Right(wk.FullName, Len(wk.FullName) - InStrRev(wk.FullName, "."))
'File Extension is now "xlsx" (without the .)
fileExtension will now contain the workbook type, which can be used as you desire.
I like to use the FileSystemObject
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.GetExtensionName(ActiveWorkbook.FullName) = "xltm" Then

Using VBA in Excel 2010

We have been using VBA code for years with Excel 2003. I have about 70 files that I pull information from and compile it into one spreadsheet. This time, it only recognizes 3 of the 70. I do not get any errors. I noticed that all 3 recognized are the old version ".xls." and all not being recognized are the ".xlsx". The portion of the code that I think is causing the problem is below. Can anyone help?
Public currApp As String
Public i As String
Public recordC As String
Public excelI As Integer
Public intFileHandle As Integer
Public strRETP As String
Public errFile As String
Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer)
'This function will loop through all files in the selected folder
'to make sure that they are all of excel type
Dim FOLDER, files, file, FSO As Object
excelI = noI
'MsgBox excelI
i = 0
'Dim writeFile As Object
'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False)
Dim cnn As Connection
Set cnn = New ADODB.Connection
currApp = ActiveWorkbook.path
errFile = currApp & "\errorFile.txt"
If emptyFile.FileExists(errFile) Then
Kill errFile
Else
'Do Nothing
End If
'cnn.Open "DSN=AUTOLIV"
'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb"
cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb")
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
'Upon each found excel file it will make a call to saveFiles.
If sFolder <> "" Then
Set FOLDER = FSO.getfolder(sFolder)
Set files = FOLDER.files
For Each file In files
'ONLY WORK WITH EXCEL FILES
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open fileName:=file.path
xlsx is a "macro-free" workbook. To use VBA in the new file format, the file must be saved as an xlsm file.
EDIT: I read the question too hastily. If you want to identify excel files from the FSO object, use file.Type LIKE "Microsoft Excel *" or similar. Or, check the file's extension against ".xls*"
EDIT
The whole concept of identifying the file type by looking at the file name is fundamentally flawed. It's too easily broken by changes to file extensions and/or the "type" texts associated with those descriptions. It's easily broken by, say, an image file named "file.xls". I would just try opening the file with Workbooks.Open and catch the error. I'd probably put this logic in a separate function:
Function OpenWorkbook(strPath As String) As Workbook
On Error GoTo ErrorLabel
Set OpenWorkbook = Workbooks.Open(strPath)
ExitLabel:
Exit Function
ErrorLabel:
If Err.Number = 1004 Then
Resume ExitLabel
Else
'other error handling code here
Resume ExitLabel
End If
End Function
Then you can consume the function like this:
Dim w As Workbook
Set w = OpenWorkbook(file.Path)
If Not (w Is Nothing) Then
'...
The problem you're having has to do with this line:
If file.Type = "Microsoft Excel Worksheet" Then
Try adding and replacing it with this:
// add these lines just AFTER the line 'For Each file In files'
IsXLFile = False
FilePath = file.path
FilePath2 = Right(FilePath, 5)
FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1)
If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True
// replace faulty line with this line
If IsXLFile = True Then
Let me know how it works. Yes, it'd be possible to compress the statements that start with FilePath into one expression but I left it like that for clarity. Vote and accept the answer if good and follow-up if not.
Have a nice day.

Resources