how to read a text using condition if - excel

I have an issue and I need your help. here is the problem. I have inside a folder some excel files that I have to open automatically in order to make some operations. Those files have the same name except the number of the files like this:
Folder name : Extraction_Files
Files name : - "System_Extraction_Supplier_1"
- "System_Extraction_Supplier_2"
- "System_Extraction_Supplier_3"
The number of files can change so i used a loop Do While to count the number of files, then the plan is to use a loop for I =1 to ( number of files) to open all of theme.
please read my code. I know that i used a wrong way to read file name using a loop for but I share it because I don't have an other idea.
Here is my code :
Sub OpenFiles ()
Dim MainPath as String
Dim CommonPath as String
Dim Count As Integer
Dim i As Integer
' the main path is " C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
'with i = 1 to Count ( file number )
CommonPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_*"
'counting automatically the file number
Filename = Dir ( CommonPath )
Do While Filename <> ""
Count = Count + 1
Filename = Dir ()
Loop
'the issue is below because this code generate a MsgBox showing a MainPath with the index i like this
'"C:\Desktop\Extraction_Files\System_Extraction_Supplier_i"
' so vba can not find the files
For i = 1 To count
MainPath = "C:\Desktop\Extraction_Files\System_Extraction_Supplier_" & "i"
MsgBox MainPath &
Workbooks.Open MainPath
Next
End Sub
what is the best approach to this?

Why not count as you open them. You're already identifying them so why not open each file as you go:
Sub OpenFiles()
Dim Filename As String
Dim CommonPath As String
Dim Count As Integer
CommonPath = "C:\Desktop\Extraction_Files\"
Filename = Dir(CommonPath & "System_Extraction_Supplier_*")
Do While Filename <> ""
MsgBox Filename
Workbooks.Open CommonPath & Filename
Count = Count + 1
Filename = Dir()
Loop
End Sub
PS. It might be worth adding .xl* or similar to the end of your search pattern to prevent Excel trying to open files that aren't Excel files:
Filename = Dir(CommonPath & "System_Extraction_Supplier_*.xl*")

If you want to open all folders, in a specific folder, which start with "NewFile_", one loop only is needed:
Sub OpenFolders()
Dim path As String: path = ""C:\Desktop\Extraction_Files\""
Dim fileStart As String: fileStart = "System_Extraction_Supplier_"
Dim Fso As Object
Dim objFolder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = Fso.GetFolder(path)
For Each objSubFolder In objFolder.subfolders
If InStr(1, objSubFolder.Name, fileStart) Then
Shell "explorer.exe " & objSubFolder, vbNormalFocus
Debug.Print objSubFolder.Name
End If
Next objSubFolder
End Sub
Folders in vba are opened with the Shell "explorer.exe " command. The code opens every folder in "C:\yourFile\", which contains NewFile_ in the name. This check is done with If InStr(1, objSubFolder.Name, fileStart) Then.

Related

Is there a way to obtain the file path of an excel sheet through a fuzzy match with a cell in a Master Excel sheet? [duplicate]

I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.

Open file which do not have standard name

Suppose, we have one folder with only one macro file and every day we are saving excel file in the same folder received via mail. However, filename every day will get changed. I mean to say what ever file we are getting through mail do not have a standard name. Now, we have two files in the same folder.
Can we open another file which we have saved with some random name available in the same folder using a macro? Here, the name of another file is not standard. Additionally, after running a macro, we also want to delete that file.
You can get the filename of the newest file within a directory by this:
Option Explicit
Private Sub GetNewestFilename()
Dim searchDirectory As String
Dim searchPattern As String
Dim currentFilename As String
Dim NewestFilename As String
Dim NewestFiledate As Date
searchDirectory = Application.DefaultFilePath & "\"
searchPattern = "*.xl*"
currentFilename = Dir(searchDirectory & searchPattern, 0)
If currentFilename <> "" Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
Do While currentFilename <> ""
If FileDateTime(searchDirectory & currentFilename) > NewestFiledate Then
NewestFilename = currentFilename
NewestFiledate = FileDateTime(searchDirectory & currentFilename)
End If
currentFilename = Dir
Loop
End If
MsgBox NewestFilename
Dim wb As Workbook
Set wb = Workbooks.Open(searchDirectory & NewestFilename)
' do something
wb.Close SaveChanges:=False
Set wb = Nothing
' Kill searchDirectory & NewestFilename ' Delete the file
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

Loop to check file existence without DIR function

I need to make a loop that will save the edited files in a folder in numerical order, but if I run the macro again it needs to keep from the last number:
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
Here the code saves the files in order (1,2,3). And if I run the macro again it needs to save (4,5,6).
I tried to use this loop above to save the function:
Do While Dir("C:\User\Desktop\Data\" & i & ".dat") = i
i = i + 1
Loop
But apparently, I can't use the DIR function, because I'm already using it at the end of the loop to get the next file, and the loop breaks.
'Get next file name
MyFile = Dir
So, is there's any way to do this? I'm trying to make a function that would check and return true or false to whether a file with that number already exists, but could not make it work. Thanks for the help.
You could get the largest number in the directory, and keep going from there?
This code presumes that all the files are named as such: [numericalfilename].[extension] for example "143.dat". This code will not work if there are alpha characters in the file-name (apart from extension)
Once you have defined Path and Extension variables, you can call the Function NextNumber which will give you [MaxNumber_In_Directory] + 1
From here you can perform your "save loop", by setting i = NextNumber(Path, "*." & Ext)
Sub test()
Dim Path As String
Dim Ext As String
Dim i as Long
' ***** REPLACE VARIABLES ******
Path = "C:\New\New Folder"
Ext = "dat"
' ******************************
i = NextNumber("C:\New\New Folder", "*." & Ext)
' ********************************
' **** PERFORM SAVE CODE HERE ****
' ********************************
'I am not 100% sure of your save loop, you'll need to modify this
wb.SaveAs "C:\User\Desktop\Data\" & i & ".dat"
i = i + 1
End Sub
Public Function NextNumber(strPath As String, strExt As String) As Long
Dim vArray(500)
Dim i As Long
Dim length As Long
ChDir strPath
strExtension = Dir(strExt)
'Perform Loop
Do While strExtension <> ""
length = Len(strExtension) - (Len(strExt) - 2) - 1
vArray(i) = CLng(Mid(strExtension, 1, length))
i = i + 1
strExtension = Dir
Loop
NextNumber = WorksheetFunction.Max(vArray) + 1
End Function

How do I check a directory for a file name given by an InputBox in VBA?

My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub

Resources