Solved

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

Posted on 2016-09-08
9
99 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
9 Comments
 
LVL 51

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 51

Expert Comment

by:Rgonzo1971
ID: 41789327
see line 14
0
Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

 
LVL 1

Author Comment

by:Hakum
ID: 41789328
soo sorry :( let me just try this :D
0
 
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 51

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 34

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.

717 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