Need help with VBA Script

H

hellfire45

Active Member
Joined
Jun 7, 2014
Messages
462
Hi Guys. Ya'll are the best so I'm sure somebody can decipher this. I have a script below that is intended to go through a folder and remove any .xlsx files which contain the string stored in the variable active_warehouse and move them over to the archive. I included the target_ext variable because I wanted the code to skip any files that were not .xlsx. There are 6 files in the warehouse holder below. 3 of them are .txt and 3 of them are .xlsx

I expect the code to check the .txt files and move on sequentially down the list of files in the folder but it just keeps checking the same file 5 times and then exits the loop.

Can somebody please suggest what might be wrong with this programming? I attached a file of the folder as well. Thanks so much!

VBA Code: 
Sub archive_wh()

Dim strFileSpec As String
Dim strFileName As String
Dim extfind As String
Dim FileInFromFolder As Object
Dim destinationpath As String
Dim fso As Object
Dim sel_warehouse As Integer
Dim active_warehouse As String
Dim sel_Year As Integer
Dim active_year As String
Dim WAREHOUSECOUNTS_STRFOLDER As String
Dim WAREHOUSECOUNTS_ARCHIVE As String
Dim target_ext As String
Dim filename_lessext As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

sel_warehouse = Application.Match("Select Warehouse", Dash.Columns(1), 0)
active_warehouse = Dash.Cells(sel_warehouse + 1, 1).Value

sel_Year = Application.Match("Select Year", Dash.Rows(sel_warehouse), 0)
active_year = Dash.Cells(sel_warehouse + 1, sel_Year).Value

WAREHOUSECOUNTS_STRFOLDER = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\WAREHOUSE COUNTS\"
WAREHOUSECOUNTS_ARCHIVE = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\ARCHIVE\WAREHOUSE COUNTS\"

target_ext = ".xlsx"

If Dir(WAREHOUSECOUNTS_ARCHIVE & "\" & active_year & "\", vbDirectory) = "" Then
            MkDir (WAREHOUSECOUNTS_ARCHIVE & "\" & active_year & "\")
End If
destinationpath = WAREHOUSECOUNTS_ARCHIVE & "\" & active_year & "\"

strFileSpec = WAREHOUSECOUNTS_STRFOLDER & "*.*"
Set fso = CreateObject("Scripting.FileSystemObject")

For Each FileInFromFolder In fso.getfolder(WAREHOUSECOUNTS_STRFOLDER).Files
            strFileName = Dir(strFileSpec)
            
            If InStr(1, strFileName, active_warehouse, 1) > 0 And InStr(1, strFileName, target_ext, 1) > 0 Then
                        fso.MoveFile Source:=WAREHOUSECOUNTS_STRFOLDER & strFileName, Destination:=destinationpath & strFileName
            End If
Next FileInFromFolder  'next iteration in loop

End Sub
 

Attachments

  • files.PNG
    files.PNG
    21.4 KB · Views: 6

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Try this. I put the updated lines painted blue

Rich (BB code): 
Sub archive_wh2()
  Dim strFileSpec As String
  Dim strFileName As String
  Dim extfind As String
  Dim FileInFromFolder As Object
  Dim destinationpath As String
  Dim fso As Object
  Dim sel_warehouse As Integer
  Dim active_warehouse As String
  Dim sel_Year As Integer
  Dim active_year As String
  Dim WAREHOUSECOUNTS_STRFOLDER As String
  Dim WAREHOUSECOUNTS_ARCHIVE As String
  Dim target_ext As String
  Dim filename_lessext As String
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  
  sel_warehouse = Application.Match("Select Warehouse", Dash.Columns(1), 0)
  active_warehouse = Dash.Cells(sel_warehouse + 1, 1).Value
  
  sel_Year = Application.Match("Select Year", Dash.Rows(sel_warehouse), 0)
  active_year = Dash.Cells(sel_warehouse + 1, sel_Year).Value
  
  WAREHOUSECOUNTS_STRFOLDER = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\WAREHOUSE COUNTS\"
  WAREHOUSECOUNTS_ARCHIVE = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\ARCHIVE\WAREHOUSE COUNTS\"
  
  target_ext = ".xlsx"
  
  If Dir(WAREHOUSECOUNTS_ARCHIVE & active_year, vbDirectory) = "" Then
    MkDir (WAREHOUSECOUNTS_ARCHIVE & active_year)
  End If

  destinationpath = WAREHOUSECOUNTS_ARCHIVE & active_year & "\"
  
  'strFileSpec = WAREHOUSECOUNTS_STRFOLDER & "*.*"
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  For Each FileInFromFolder In fso.getfolder(WAREHOUSECOUNTS_STRFOLDER).Files
    strFileName = Mid(FileInFromFolder, InStrRev(FileInFromFolder, "\") + 1)
    If InStr(1, strFileName, active_warehouse, 1) > 0 And InStr(1, strFileName, target_ext, 1) > 0 Then
      fso.MoveFile Source:=WAREHOUSECOUNTS_STRFOLDER & strFileName, Destination:=destinationpath & strFileName
    End If
  Next FileInFromFolder  'next iteration in loop

End Sub
 
Upvote 0
Try this (not tested)

VBA Code: 
Sub archive_wh()
  
    Dim strFileName As String
    Dim sel_warehouse As Long
    Dim active_warehouse As String
    Dim sel_Year As Long
    Dim active_year As String
    Dim WAREHOUSECOUNTS_STRFOLDER As String
    Dim WAREHOUSECOUNTS_ARCHIVE As String
    Dim counter As Long
  
    sel_warehouse = Application.Match("Select Warehouse", Dash.Columns(1), 0)
    active_warehouse = Dash.Cells(sel_warehouse + 1, 1).Value
  
    sel_Year = Application.Match("Select Year", Dash.Rows(sel_warehouse), 0)
    active_year = Dash.Cells(sel_warehouse + 1, sel_Year).Value
  
    WAREHOUSECOUNTS_STRFOLDER = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\WAREHOUSE COUNTS\"
    WAREHOUSECOUNTS_ARCHIVE = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\ARCHIVE\WAREHOUSE COUNTS\" & active_year & "\"
  
    If Dir(WAREHOUSECOUNTS_ARCHIVE, vbDirectory) = "" Then MkDir WAREHOUSECOUNTS_ARCHIVE
  
    strFileName = Dir(WAREHOUSECOUNTS_STRFOLDER & "*" & active_warehouse & "*.xlsx")
    Do While strFileName <> ""
        DoEvents
        Name WAREHOUSECOUNTS_STRFOLDER & strFileName As WAREHOUSECOUNTS_ARCHIVE & strFileName
        strFileName = Dir
        counter = counter + 1
    Loop
  
    MsgBox counter & " files moved." & vbLf & vbLf & _
           "Warehouse: " & active_warehouse & vbLf & _
           "Year: " & active_year, _
           vbInformation, "File Archive Complete"
  
End Sub
 
Last edited:
Upvote 0
DanteAmor said:
Try this. I put the updated lines painted blue

Rich (BB code): 
Sub archive_wh2()
  Dim strFileSpec As String
  Dim strFileName As String
  Dim extfind As String
  Dim FileInFromFolder As Object
  Dim destinationpath As String
  Dim fso As Object
  Dim sel_warehouse As Integer
  Dim active_warehouse As String
  Dim sel_Year As Integer
  Dim active_year As String
  Dim WAREHOUSECOUNTS_STRFOLDER As String
  Dim WAREHOUSECOUNTS_ARCHIVE As String
  Dim target_ext As String
  Dim filename_lessext As String
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.EnableEvents = False
 
  sel_warehouse = Application.Match("Select Warehouse", Dash.Columns(1), 0)
  active_warehouse = Dash.Cells(sel_warehouse + 1, 1).Value
 
  sel_Year = Application.Match("Select Year", Dash.Rows(sel_warehouse), 0)
  active_year = Dash.Cells(sel_warehouse + 1, sel_Year).Value
 
  WAREHOUSECOUNTS_STRFOLDER = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\WAREHOUSE COUNTS\"
  WAREHOUSECOUNTS_ARCHIVE = "R:\Materials\INVENTORY CONTROL FILE\IN PROGRESS\WAREHOUSE INVENTORY AUTOMATION\ARCHIVE\WAREHOUSE COUNTS\"
 
  target_ext = ".xlsx"
 
  If Dir(WAREHOUSECOUNTS_ARCHIVE & active_year, vbDirectory) = "" Then
    MkDir (WAREHOUSECOUNTS_ARCHIVE & active_year)
  End If

  destinationpath = WAREHOUSECOUNTS_ARCHIVE & active_year & "\"
 
 'strFileSpec = WAREHOUSECOUNTS_STRFOLDER & "*.*"
  Set fso = CreateObject("Scripting.FileSystemObject")
 
  For Each FileInFromFolder In fso.getfolder(WAREHOUSECOUNTS_STRFOLDER).Files
    strFileName = Mid(FileInFromFolder, InStrRev(FileInFromFolder, "\") + 1)
    If InStr(1, strFileName, active_warehouse, 1) > 0 And InStr(1, strFileName, target_ext, 1) > 0 Then
      fso.MoveFile Source:=WAREHOUSECOUNTS_STRFOLDER & strFileName, Destination:=destinationpath & strFileName
    End If
  Next FileInFromFolder  'next iteration in loop

End Sub
Click to expand...

Hi Dante,

This seems to work better! Can you help me understand how you made it better so that it works? What was the change made? Trying to learn. Thanks!
 
Upvote 0
hellfire45 said:
Hi Dante,
This seems to work better! Can you help me understand how you made it better so that it works? What was the change made? Trying to learn. Thanks!
Click to expand...

You had this line:
strFileName = Dir(strFileSpec)

The variable "strFileName" stores the names of the files that are inside the directory.
But this line is not necessary since you have the names of the files in the "FileInFromFolder" variable

What I did is extract the file name of the variable "FileInFromFolder", I say extract, because within that variable you also have the name of the folder.

And that's it. I'm glad to know that it works for you. Thanks for the feedback.
 
Upvote 0
DanteAmor said:
You had this line:
strFileName = Dir(strFileSpec)

The variable "strFileName" stores the names of the files that are inside the directory.
But this line is not necessary since you have the names of the files in the "FileInFromFolder" variable

What I did is extract the file name of the variable "FileInFromFolder", I say extract, because within that variable you also have the name of the folder.

And that's it. I'm glad to know that it works for you. Thanks for the feedback.
Click to expand...

I see. Thanks for the explanation. May I follow up and ask why the strFileName variable I was using to start with wasn't working to begin with?
 
Upvote 0
hellfire45 said:
I see. Thanks for the explanation. May I follow up and ask why the strFileName variable I was using to start with wasn't working to begin with?
Click to expand...

Because you use Dir() or you use fso.files, but not both at the same time.

The structure of Dir() is how AlphaFrog used it:
Rich (BB code): 
    strFileName = Dir(folder & xFile)
    Do While strFileName <> ""
        'instructions
        strFileName = Dir()
    Loop

And this is the fso structure
Rich (BB code): 
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each xFile In fso.getfolder(folder).Files
    'instructions
  Next
 
Upvote 0
hellfire45 said:
... why the strFileName variable I was using to start with wasn't working to begin with?
Click to expand...

One other notable issue you had in your original code was double backslashes.
Rich (BB code): 
If Dir(WAREHOUSECOUNTS_ARCHIVE & "\" & active_year & "\", vbDirectory) = "" Then

WAREHOUSECOUNTS_ARCHIVE already ended with a "\". No need to include another one.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
VBA Script: Saving worksheet as CSV on MacOS
Replies
1
Views
866
temphelp
T
N
  • Locked
  • Question
VBA code doesn't work
Replies
3
Views
474
Fluff
Fluff
R
  • Solved
combining csv workbooks to single sheet - vba works but need help adjusting
Replies
4
Views
439
Alex Blakenburg
A
P
  • Locked
  • Question
Edit VBA code to let it automatically create Folder
Replies
5
Views
457
RoryA
RoryA
H
  • Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
2K
HeinrichPaul
H

Forum statistics

Threads
1,214,620
Messages
6,120,554
Members
448,970
Latest member
kennimack

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top