Extracting data from File names

[greatsenshi]

Hi,

I was wondering if anyone can help me with a problem Im trying to solve. But not entirely sure if this is even possible

So we use a bunch of equipment at work that spits out a pdf file that is going to consist the results of a particular test.
Those files are named in a unique format. It looks a bit like this:-
EH_CM42_EB0C8105G00_CPS41D_F30C3105E00_2013_09_10_08_39_25.pdf

Out of this file name it consist of the serial number (F30C3105E00) of the equipment which is the first set off italics/bold and time(08_39) and date (2013_09_10) this test was performed.

So My question is there a way or a vbs macro or anything that will be extract these three different information and save them in three different cells on the spreadsheet. BTW Also I should mention that these files are going to be stored on a network drive

PS- The only way I have figured out to do this is to create a .bat file that runs the dir command and saves it to a text file. Dont know if this can help anyone

Thanks,
Michael

 

[AlphaFrog]

Try this. Change the file path to suit.

[color=darkblue]Sub[/color] Extract_From_File_Name()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color], strFile [color=darkblue]As[/color] [color=darkblue]String[/color], v [color=darkblue]As[/color] [color=darkblue]Variant[/color], NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    strPath = [B]"C:\Test\"[/B]    [color=green]'Source directory[/color]
    NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    
    strFile = Dir$(strPath & "*.pdf")
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        v = Split(strFile, "_")
        [color=darkblue]If[/color] [color=darkblue]UBound[/color](v) >= 9 [color=darkblue]Then[/color]
            Range("A" & NextRow).Value = v(4)
            Range("B" & NextRow).Value = DateSerial(v(5), v(6), v(7))
            Range("C" & NextRow).Value = TimeSerial(v(8), v(9), 0)
            NextRow = NextRow + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        strFile = Dir$
    [color=darkblue]Loop[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[greatsenshi]

Hi,
First off thanks for the quick awesome reply.
Secondly is it possible to make this search sub-folders and only add new entires?
Ill test it when i get back to work on tuesday, but it seems to run very well on the test batch I brought back thisafternoon.

PS- I know im asking alot but is it also possible to make hyperlinks to the file 11 columns away from the time column?

 

[AlphaFrog]

[color=darkblue]Sub[/color] Extract_From_File_Name()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color], NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color], StartRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    strPath = [B]"C:\Test\" [/B]   [color=green]'Source directory[/color]
    NextRow = Range("A" & Rows.Count).End(xlUp).Row
    StartRow = NextRow
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    Process_Files CreateObject("Scripting.FileSystem[color=darkblue]Object[/color]").GetFolder(strPath), NextRow, [color=darkblue]True[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox NextRow - StartRow & " new files found. ", vbInformation, "Process Complete"
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
    
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Process_Files([color=darkblue]ByVal[/color] fsoFolder [color=darkblue]As[/color] [color=darkblue]Object[/color], [color=darkblue]ByRef[/color] NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color], _
                          [color=darkblue]Optional[/color] [color=darkblue]ByRef[/color] bIncludeSubfolders [color=darkblue]As[/color] [color=darkblue]Boolean[/color] = [color=darkblue]False[/color])
    
    [color=darkblue]Dim[/color] fsoFile [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] fsoSubFolder [color=darkblue]As[/color] Object
    [color=darkblue]Dim[/color] v [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    
    [color=darkblue]With[/color] ActiveSheet
        [color=darkblue]For[/color] [color=darkblue]Each[/color] fsoFile [color=darkblue]In[/color] fsoFolder.Files
            [color=darkblue]If[/color] LCase(Right(fsoFile.Name, 4)) = ".pdf" [color=darkblue]Then[/color]
                [color=darkblue]If[/color] IsError(Application.Match(fsoFile.Name, .Range("N:N"), 0)) [color=darkblue]Then[/color]
                    v = Split(fsoFile.Name, "_")
                    [color=darkblue]If[/color] [color=darkblue]UBound[/color](v) >= 9 [color=darkblue]Then[/color]
                        NextRow = NextRow + 1
                        .Range("A" & NextRow).Value = v(4)
                        .Range("B" & NextRow).Value = DateSerial(v(5), v(6), v(7))
                        .Range("C" & NextRow).Value = TimeSerial(v(8), v(9), 0)
                        .Hyperlinks.Add Range("N" & [color=darkblue]Next[/color]Row), fsoFile.Path, _
                                        TextToDisplay:=fsoFile.Name
                    [color=darkblue]End[/color] [color=darkblue]If[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        Next fsoFile
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]If[/color] bIncludeSubfolders [color=darkblue]Then[/color]
        [color=darkblue]For[/color] [color=darkblue]Each[/color] fsoSubFolder [color=darkblue]In[/color] fsoFolder.Subfolders
            Process_Files fsoSubFolder, NextRow, [color=darkblue]True[/color]
        Next fso[color=darkblue]Sub[/color]Folder
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] Sub

 

[greatsenshi]

Thank you so much for all your help, im not great with vb and this would of taken me all weekend. Do you have any tips on how to makethe pdfs organise into folders by their serial number?

 

[AlphaFrog]

Thank you so much for all your help, im not great with vb and this would of taken me all weekend. Do you have any tips on how to makethe pdfs organise into folders by their serial number?

You're welcome and sorry no.