Link to home
Start Free TrialLog in
Avatar of Harsh Kumar
Harsh KumarFlag for Denmark

asked on

VBScript - Find file starting with XXXX use that in runnig rest of code

Hi guys,

I'm pretty new in VBscript/VBA and im trying to learn. I'm trying to figur out a way to find the latest file created with a fixed starting name and then use that in the code

What the code does is basically open up one file and then save it again as *.xls

So the code pretty much only needs to have the "SourceFile=" changed

here is my code:
Dim xlApp, xlWkb, SourceFolder, TargetFolder, file

Set xlApp = CreateObject("excel.application")
Set fs = CreateObject("Scripting.FileSystemObject")

Const xlNormal = 1

SourceFile = "ALDEALSPOT_?????.xls"  '<== ****EDIT THIS****
SourceFolder = "C:\Temp\xml\" & SourceFile  '<== ****ONLY EDIT THE FOLDER LOCATION****
TargetFolder = "C:\Temp\xls"  ' <== ****EDIT THIS****

xlApp.Application.DisplayAlerts = False

'Hide Excel
xlApp.Visible = False

'Open file in SourceFolder
Set xlWkb = xlApp.Workbooks.Open(SourceFolder)

'Concatenate full path. Extension will be automatically added by Excel
FullTargetPath = TargetFolder & "\" & SourceFile

'Save as XLS file into TargetFolder
xlWkb.SaveAs FullTargetPath, xlNormal 'Saves in xls
'xlWkb.SaveAs FullTargetPath, xltext ' Saves in txt

'Close file
xlWkb.Close
'Next

Set xlWkb = Nothing
Set xlApp = Nothing
Set fs = Nothing

Open in new window

Avatar of Rgonzo1971
Rgonzo1971

Hi,

pls try something like this

Dim xlApp, xlWkb, SourceFolder, TargetFolder, oFile, oLastFile
Set oLastFile = Nothing
Set xlApp = CreateObject("excel.application")
Set fs = CreateObject("Scripting.FileSystemObject")

Const xlNormal = 1

SourceFile = "ALDEALSPOT_?????.xls"  '<== ****EDIT THIS****
SourceFolder = "C:\Temp\xml\" & SourceFile  '<== ****ONLY EDIT THE FOLDER LOCATION****
TargetFolder = "C:\Temp\xls"  ' <== ****EDIT THIS****
Set oLastFile = Nothing
Set goFS = CreateObject("Scripting.FileSystemObject")
For Each oFile In goFS.GetFolder(SourceFolder).Files
    If Left(oFile.Name, 11) = Left(SourceFile, 11) Then
       If oLastFile Is Nothing Then
          Set oLastFile = oFile ' the first could be the last
       Else
          If oFile.DateLastModified > oLastFile.DateLastModified Then
             Set oLastFile = oFile
          End If
       End If
    End If
Next
If Not oLastFile Is Nothing Then
    xlApp.Application.DisplayAlerts = False
    
    'Hide Excel
    xlApp.Visible = False
    
    'Open file in SourceFolder
    Set xlWkb = xlApp.Workbooks.Open(oLastFile.Path)
    
    'Concatenate full path. Extension will be automatically added by Excel
    FullTargetPath = TargetFolder & "\" & oLastFile.Name
    
    'Save as XLS file into TargetFolder
    xlWkb.SaveAs FullTargetPath, xlNormal 'Saves in xls
    'xlWkb.SaveAs FullTargetPath, xltext ' Saves in txt
    
    'Close file
    xlWkb.Close
    'Next
Else
   WScript.Echo "no file found"
   
End If


Set xlWkb = Nothing
Set xlApp = Nothing
Set fs = Nothing

Open in new window

Regards
Avatar of Harsh Kumar

ASKER

Thank you for your reply!

Sadly there is thounds of files in the folder and I need to find a specific series of files staring with: "ALDEALSPOT_" how can this be done? as far as i understand with your code it simply just takes the lastmodified, but it has to be the last modified ALDEALSPOT_ file

kindly advise
see line 14
soo sorry :( let me just try this :D
not working for me sadly.... and that could be because of Line 8

i get this error:

User generated image
I'm guessing you somehow have to search for the starting name of the file?
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
E.g.

Option Explicit

Const NO_FILE_FOUND = "<n/a>"
Const SOURCE_FOLDER = "C:\Temp\"
  
Dim fileFound

fileFound = NewestFile(SOURCE_FOLDER, "^ALDEALSPOT_.+\.xls$")
If fileFound <> NO_FILE_FOUND Then
  CopyExcelFile SOURCE_FOLDER, fileFound
End If

Function RegExLike(AInputString, APattern)

  Dim regexValid
  
  Set regexValid = New RegExp    
  regexValid.Global = True
  regexValid.IgnoreCase = True  
  regexValid.Pattern = APattern
  RegExLike = regexValid.Test(AInputString) 
  Set regexValid = Nothing

End Function

Function NewestFile(ASourceFolder, AFileMask)
  
  On Error Resume Next
  
  Dim fso
  Dim file
  Dim mostRecentFile
  
  NewestFile = NO_FILE_FOUND
  Set file = Nothing
  Set mostRecentFile = Nothing
  Set fso = CreateObject("Scripting.FileSystemObject")  
  For Each file In fso.GetFolder(ASourceFolder).Files  
    If RegExLike(file.Name, AFileMask) Then	
	  If mostRecentFile Is Nothing Then
        Set mostRecentFile = file
	  End If
      
	  If (file.DateLastModified > mostRecentFile.DateLastModified) Then
        Set mostRecentFile = file
      End If
	End If
  Next
    
  If Not mostRecentFile Is Nothing Then
    NewestFile = mostRecentFile.Name
  End If
  
  Set file = Nothing
  Set mostRecentFile = Nothing
  Set fso = Nothing
  
End Function

Sub CopyExcelFile(ASourceFolder, ASourceFile)  
 
  Const XL_NORMAL = 1
  
  Dim xlApp
  Dim xlWkb
  Dim FullTargetPath
  Dim SourceFolder
  Dim TargetFolder  
  
  Set xlApp = CreateObject("excel.application")     
  SourceFolder = ASourceFolder & ASourceFile  
  TargetFolder = "C:\Temp\xls"  
  FullTargetPath = TargetFolder & "\" & ASourceFile    
  xlApp.Application.DisplayAlerts = False  
  xlApp.Visible = False    
  Set xlWkb = xlApp.Workbooks.Open(SourceFolder)  
  xlWkb.SaveAs FullTargetPath, XL_NORMAL 
  xlWkb.Close  
  Set xlWkb = Nothing
  Set xlApp = Nothing
  	
End Sub

Open in new window

Works like a charm!!! Thank alot!