Solved

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

Posted on 2016-09-08
9
56 Views
Last Modified: 2016-09-08
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

0
Comment
Question by:Hakum
  • 5
  • 3
9 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 41789321
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
0
 
LVL 1

Author Comment

by:Hakum
ID: 41789325
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
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 41789327
see line 14
0
 
LVL 1

Author Comment

by:Hakum
ID: 41789328
soo sorry :( let me just try this :D
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 1

Author Comment

by:Hakum
ID: 41789338
not working for me sadly.... and that could be because of Line 8

i get this error:

error
0
 
LVL 1

Author Comment

by:Hakum
ID: 41789341
I'm guessing you somehow have to search for the starting name of the file?
0
 
LVL 48

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41789347
then try
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" '<== ****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

0
 
LVL 32

Expert Comment

by:ste5an
ID: 41789360
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

0
 
LVL 1

Author Closing Comment

by:Hakum
ID: 41789362
Works like a charm!!! Thank alot!
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
This article will show, step by step, how to integrate R code into a R Sweave document
The viewer will learn how to dynamically set the form action using jQuery.
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now