In my never ending story to learn VBA I am trying to create a macro that deletes files based on the files starting characters and unsure how to proceed.
I have an excel file with numbers in column a ,these numbers are either 4,5 or 6 digits.
I have a file folder with files which may or may not start with these digits from a range from excel file. These files in folders are of different types
But I reckon this may not be an issue still,the naming convention is as follows : ie. 4563_listofitems.pdf,65475_skusdec.doc etc.
My goal is to loop through files and check if the starting characters of the file are on included in the A range of the excel sheet,if so (there may be up to 6 files starting with such number) create a folder named with the found starting characters and move the files starting with these characters into the folder,else if file doesn't start with fixed characters from the list then just delete (kill) that file. My issue is idk how to check the files names against the list.
My code as now for looping trough
Sub loopf
Dim filen as variant
Filen =dir("c:\test\")
While filen <>""
If instr(1,filen,10000)=1 then
'Here I want check against the values from range but unsure how ,should I somehow loop through the range ?
Filen=dir
End if
Wend
End sub
CodePudding user response:
To check if a value is contained within a known list, I like using the Dictionary Object. It has the function Exists
which checks if a value is listed within the Dictionary.
So before you loop through the files, you just need to add every one of your accepted numbers into the dictionary. Then while looping though the files check if Dictionary.Exists(Value)
. If it exists, then the value is good, if not then Kill
.
Here's how I would set that up:
Sub loopf()
Dim AcceptedPrefixes As Object
Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
Dim PrefixRange As Range
Set PrefixRange = ThisWorkbook.Sheets(1).Range("A1:A5")
Dim Cell As Range
For Each Cell In PrefixRange.Cells
If Cell <> "" And Not AcceptedPrefixes.exists(Cell.Value) Then
AcceptedPrefixes.Add CStr(Cell.Value), 0
End If
Next
Dim Directory As String
Directory = "c:\test\"
Dim filen As Variant
filen = Dir(Directory)
While filen <> ""
Dim FilePrefix As String
FilePrefix = Split(filen, "_")(0)
If Not AcceptedPrefixes.exists(FilePrefix) Then
Kill Directory & filen
End If
filen = Dir
Wend
End Sub
CodePudding user response:
Sub Files()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\test")
For Each oFile In oFolder.Files
'do somthing
Next oFile
End Sub