macro to populate file path if the path contains the text in the cell

techie5

New Member
Joined
Aug 26, 2014
Messages
2
Hello All,

I have a folder that contains multiple zip files with some numbers separated by a "-" on it eg: 10123-45903-09354.zip, 99345-12367.zip, etc..I'm trying to list the file path against a cell that contains one of these numbers. If it does not then put in "does not exist"

eg:
[TABLE="class: grid, width: 800, align: center"]
<tbody>[TR]
[TD]Numbers[/TD]
[TD]Path[/TD]
[/TR]
[TR]
[TD]10123[/TD]
[TD]this should read the 10123-45903-09354.zip path and store here[/TD]
[/TR]
[TR]
[TD]56338[/TD]
[TD]does not exist[/TD]
[/TR]
[TR]
[TD]34689[/TD]
[TD]does not exist[/TD]
[/TR]
[TR]
[TD]99345[/TD]
[TD]this should read the 99345-12367.zip and store here[/TD]
[/TR]
</tbody>[/TABLE]

This is what i've done so far:
<dl class="codebox"><dt>
</dt>
Code:
<dd><code>Dim rnum, fname, pathname, fpath As String
Dim i, x As Integer

pathname = ActiveWorkbook.Path & "\"
fname = Dir(pathname & "*.zip")

i = 2
x = ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row

While i <= x
rnum = Trim(ThisWorkbook.Sheets(1).Range("A" & i).Value)
Do While fname <> ""
fpath = pathname & fname
If InStr(fpath, rnum) > 0 Then
ThisWorkbook.Sheets(1).Range("B" & i).Value = fpath
Exit Do
Else
ThisWorkbook.Sheets(1).Range("B" & i).Value = "not found"
End If
fname = Dir()
Loop
i = i + 1
Wend</code>
</dd></dl>

can somebody please help?
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hi, and welcome to Mr Excel.

So near, yet so far :)

Try this:
Code:
Sub xx()
    Dim rnum As String, fname As String, pathname As String, fpath As String
    Dim i As Integer
    Dim Found As Boolean
    
    pathname = ActiveWorkbook.Path & "\"
    
    i = 2
    While i <= ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row
        fname = Dir(pathname & "*.zip")
        rnum = Trim(ThisWorkbook.Sheets(1).Range("A" & i).Value)
        Found = False
        Do While fname <> ""
            fpath = pathname & fname
            If InStr(fpath, rnum) > 0 Then
                ThisWorkbook.Sheets(1).Range("B" & i).Value = fpath
                Found = True
                Exit Do
            End If
            fname = Dir()
        Loop
        If Not Found Then ThisWorkbook.Sheets(1).Range("B" & i).Value = "not found"
        i = i + 1
    Wend
    
End Sub

I straightened out some of your Dim statements. Excel VBA is a bit strange. Just putting variables in a line does not automatically make them like the last one. The first ones would have been Variants - the default value.

Next you need to decide whether you are going to pick a row and cycle round the files or pick a file and cycle round the folders.

I created a new variable called Found. This becomes True if a match is found.

I picked a row and cycled round the folders.
So, initialize Dir.
Look for a match.
If found then remember that and leave the loop.
If not, get the next file and repeat.
When the loop finishes see if a file was found, if not then display the not found message.

Regards,
 
Upvote 0
Here is another way to write the macro...
Code:
Sub ZipPath()
  Dim X As Long, FileName As String, Path As String
  Path = ActiveWorkbook.Path & "\"
  For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    FileName = Dir(Path & "*" & Cells(X, "A").Value & "*.zip")
    If "-" & Replace(FileName, ".", "-") Like "*-" & Cells(X, "A").Value & "-*" Then Cells(X, "B").Value = Path & FileName
  Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,226,617
Messages
6,192,043
Members
453,691
Latest member
CT30

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