• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 273
  • Last Modified:

VBScript help

Hi:

In a folder I have Excel files named with dates like:
myfilename_11012008,xls
myfilename_11022008.xls
---
myfilename_11122008.xls

These files have a Workbook_Open() procedure  to do some task and save itself automatically when the workbook is opened.

I need a vb script that'll be run daily to:
1. figure out the file name of yesterday's file.
2. save that file as myfilename_<today's date>.xls (This shouldn't be a problem even if the original file is opened/being viewed by another user, I think?)
3. open it - so the vba code I wrote will do the updates and save itself.

I need to finish this quickly but unfortunately I am new to vb script. Please help.
0
sdc248
Asked:
sdc248
  • 4
  • 2
1 Solution
 
lewismayCommented:
Hello,

The following code should work for you if you change the paths. You may want to add some error trapping in case the file can not be found.

Hope this works for you, enjoy
Dim shell, file_path, old_file_name, new_file_name
 
Set shell = CreateObject("WScript.Shell")
 
file_path = "c:\yourdir\"
old_file_name = "myfilename_" & get_date(-1) & ".xls"
new_file_name = "myfilename_" & get_date(0) & ".xls"
 
Call shell.Run("cmd /c copy " & chr(34) & file_path & old_file_name & chr(34) & " " & _
               chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Call shell.Run("cmd /c " & chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Private Function get_date(day_offset)
 
  Dim day_string, month_string
 
  get_date = DateAdd("d", day_offset, Date())
 
  day_string = DatePart("d", get_date)
  month_string = DatePart("m", get_date)
 
  If(len(day_string) < 2) Then day_string = "0" & day_string
  If(len(month_string) < 2) Then month_string = "0" & month_string
 
  get_date = (month_string & day_string & DatePart("yyyy", get_date))
 
End Function

Open in new window

0
 
sdc248Author Commented:
Thanks for the code, Lewismay.

Is there a way to first test whether the old file for yesterday is there, if not, try the day before and so on? I am thinking of a loop that trys 10 days before giving up and exit.
0
 
lewismayCommented:
Ok something like this will probably work

Dim shell, fso
Dim file_path, old_file_name, new_file_name, i
 
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
 
file_path = "c:\yourdir\"
old_file_name = "myfilename_" & get_date(-1) & ".xls"
new_file_name = "myfilename_" & get_date(0) & ".xls"
 
i = -1
 
Do Until (fso.FileExists(file_path & old_file_name))
 
  i = i - 1
  old_file_name = "myfilename_" & get_date(i) & ".xls"
 
  If i < -10 Then Exit Do
  
Loop
 
Call shell.Run("cmd /c copy " & chr(34) & file_path & old_file_name & chr(34) & " " & _
               chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Call shell.Run("cmd /c " & chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Private Function get_date(day_offset)
 
  Dim day_string, month_string
 
  get_date = DateAdd("d", day_offset, Date())
 
  day_string = DatePart("d", get_date)
  month_string = DatePart("m", get_date)
 
  If(len(day_string) < 2) Then day_string = "0" & day_string
  If(len(month_string) < 2) Then month_string = "0" & month_string
 
  get_date = (month_string & day_string & DatePart("yyyy", get_date))
 
End Function

Open in new window

0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
lewismayCommented:
Whoops slight mistake i needs to start at 0, or you need to decrement after generating the file name, fixed code below
Dim shell, fso
Dim file_path, old_file_name, new_file_name, i
 
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
 
file_path = "c:\yourdir\"
old_file_name = "myfilename_" & get_date(-1) & ".xls"
new_file_name = "myfilename_" & get_date(0) & ".xls"
 
i = 0
 
Do Until (fso.FileExists(file_path & old_file_name))
 
  i = i - 1
  old_file_name = "myfilename_" & get_date(i) & ".xls"
 
  If i < -10 Then Exit Do
  
Loop
 
Call shell.Run("cmd /c copy " & chr(34) & file_path & old_file_name & chr(34) & " " & _
               chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Call shell.Run("cmd /c " & chr(34) & file_path & new_file_name & chr(34), 0, true)
 
Private Function get_date(day_offset)
 
  Dim day_string, month_string
 
  get_date = DateAdd("d", day_offset, Date())
 
  day_string = DatePart("d", get_date)
  month_string = DatePart("m", get_date)
 
  If(len(day_string) < 2) Then day_string = "0" & day_string
  If(len(month_string) < 2) Then month_string = "0" & month_string
 
  get_date = (month_string & day_string & DatePart("yyyy", get_date))
 
End Function

Open in new window

0
 
sdc248Author Commented:
The code works fine until, when running the new file, the program hangs and a dialogue window pops up asking whether to enable macro. How to work around this? Thansk.
0
 
lewismayCommented:
You just need to set macro security in excel to Low
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now