• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Convert VBScript to VBA (Copy and Replace Activeworkbook)

YasserKhalil

Well-Known Member
Hello everyone

I have following code (VBScript) in vbs file named "Update.vbs"
Code:
SourceFile =WScript.Arguments.Item(0)
DestinationFile=WScript.Arguments.Item(1)
DestinationFolder=WScript.Arguments.Item(2)

'Close Existing Workbook
Set objXl = GetObject(, "Excel.Application")
on Error Resume Next
objXL.Workbooks("MyProject.xlsm").Close(False)

'Install New XLSM Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
    'Check To See If The File Already Exists In The Destination Folder
    If fso.FileExists(DestinationFile) Then
        'Check To See If The File Is Read-Only
        If Not fso.GetFile(DestinationFile).Attributes And 1 Then
            'The File Exists And Is Not Read-Only.  Safe To Replace The File
            fso.CopyFile SourceFile, DestinationFolder, True
        Else
            'The File Exists And Is Read-Only, Remove The Read-Only Attribute
            fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1
            'Replace The File
            fso.CopyFile SourceFile, DestinationFolder, True
            'Reapply The Read-Only Attribute
            fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1
        End If
    Else
        'The File Does Not Exist In The Destination Folder.  Safe To Copy File To This Folder
        fso.CopyFile SourceFile, DestinationFolder, True
    End If
Set fso = Nothing

objXL.Workbooks.Open(DestinationFile)
The code is executed in Activeworkbook in workbook_Open event like that
Code:
     strCopyTo = ThisWorkbook.FullName
                    strCurrPath = ThisWorkbook.Path & "\"
                    strCopyFrom = dlPath & "\MyProject.xlsm"
                    Shell "wscript.exe """ & dlPath & "\Update.vbs""" & " """ & strCopyFrom & """ """ & strCopyTo & """ """ & strCurrPath & """"
It is supposed that the vbs code will copy the workbook named "MyProject.xlsm" from dlPath to the ActiveWorkbook path (activeworkbook with the same name MyProject) and replace the activeworkbook with the new one from dlPath

Is it possible to do that without the vbs file??

Simply I mean I need to copy and replace the existing opened workbook with a workbook from specific path

* The activeworkbook may be with a different name

The thread is posted here too
http://www.eileenslounge.com/viewtopic.php?f=30&t=33176
 

Kenneth Hobson

Active Member
Using that sort of approach, one could use Excel's command line method with API commands. You can search for "vba excel command line arguments". When I did this years ago, these links were helpful. The first two explain Excel's command line options.

You would likely have a similar security issue for BAT files. Other ways to pass the command line parameter values are shown in the links below. I would try Shell() first though. If just for yourself, you can hard code the path to excel.exe. If for anyone, search for my EXEPATH() API routine or post back.

I recommend doing this using a simple test workbook to execute the command line parameters in a simple way first. I can post an example if needed but the links below detail it pretty well.


The vbs code is easily converted to VBA for the external XLSM file's open event as the links above detail.
 

Kenneth Hobson

Active Member
I could work up an example for post #2 but there are more simple ways to achieve your goals. e.g.

1. Create a workbook with a macro that has inputs for what you want to do.
2. Open that workbook from the other.
3. Use Application.Run to run (1) and pass the other workbook's details as input parameters. This is the same concept as command line parameters but no parsing is needed. We do this all the time in Sub and Function.
4. (1)'s routine would be similar to your vbs code.

This method is very simple but if you get stuck, post back.
 

YasserKhalil

Well-Known Member
Thanks a lot. In fact I am totally confused and don't know how to do that.
Can you help me with a code that do the same as in the vbs code?
 

Kenneth Hobson

Active Member
It is better to explain your goals first. There may be other ways to reach them. As you say, it is confusing.

Your code copies one hard coded file to a folder. I like to be more specific and fully name the source and destination. It gets hard to figure out just what is what in your code. For this reason, sometimes I like to name the variables that I send to a called routine to be the same as the input variable names or at least similar. e.g. SourceFile, sFile, DestinationFile, dFile, etc.

Example Conditions/Goals:
1. Current workbook open is c:\ken\MyProjects.xlsm.
2. Copy c:\ken\templates\MyProjects.xlsm and name it c:\ken\MyProject.xlsm.
a. If c:\ken\MyProject.xlsm exists already, do not copy. That would be the case here.
b. Or, If c:\ken\MyProject.xlsm exists already (open already so we know that), close it and then overwrite it.

For Excel, we can not have more than one MyProjects.xlsm open at any time. That is why some of this is more complicated that it should be. It gets tricky closing a workbook before all of the code has been executed. Likely, that is why the vbs file was used.
 

Kenneth Hobson

Active Member
If you want to play with the Application.Run method, see the two files. It does not close the SaySomething.xlsm file. Check out both files or code here and edit to suit. They should be close to meeting the goals.

SeeSomething.xlsm:
Code:
Private Sub CommandButton1_Click()
    Dim fn As String, sFile As String, dFolder As String, dFile As String
   
    sFile = "c:\MyFiles\Excel\t\MyProject.xlsm"
    dFolder = Environ("temp") & "\"
    dFile = dFolder & "MyProject"
   
    fn = ThisWorkbook.Path & "\SaySomething.xlsm"
    Workbooks.Open fn
    'mMain.CloseCopyOpen(SourceFile As String, DestinationFile As String, _
        DestinationFolder As String)
    Application.Run "'" & fn & "'!mMain.CloseCopyOpen", _
        sFile, _
        dFile, _
        dFolder
End Sub
SaySomething.xlsm, Module mMain. Uncomment the Exit Sub and comment or delete the MsgBox(). Those were for testing.
Code:
Sub CloseCopyOpen(SourceFile As String, DestinationFile As String, _
    DestinationFolder As String)
   
    Dim fn As String
   
    MsgBox "SourceFile: " & SourceFile & vbCr & "DestinationFile: " & _
        DestinationFile & vbCr & "DestinationFolder: " & DestinationFolder
    Exit Sub


    'Install New XLSM Workbook
    With CreateObject("Scripting.FileSystemObject")
        'Close Existing Workbook
        'Workbooks("MyProject.xlsm").Close False
        fn = .GetFilename(DestinationFile)  'The file that called this.
        Debug.Print fn
        Workbooks(fn).Close False
       
        'Check To See If The File Already Exists In The Destination Folder
        If .FileExists(DestinationFile) Then
            'Check To See If The File Is Read-Only
            If Not .GetFile(DestinationFile).Attributes And 1 Then
                'The File Exists And Is Not Read-Only.  Safe To Replace The File
                .CopyFile SourceFile, DestinationFolder, True
                Else
                'The File Exists And Is Read-Only, Remove The Read-Only Attribute
                .GetFile(DestinationFile).Attributes = .GetFile(DestinationFile).Attributes - 1
                'Replace The File
                .CopyFile SourceFile, DestinationFolder, True
                'Reapply The Read-Only Attribute
                .GetFile(DestinationFile).Attributes = .GetFile(DestinationFile).Attributes + 1
            End If
            Else
            'The File Does Not Exist In The Destination Folder.  Safe To Copy File To This Folder
            .CopyFile SourceFile, DestinationFolder, True
        End If
    End With

    Workbooks.Open DestinationFile
    ThisWorkbook.Close False
End Sub
 

Attachments

Last edited:

YasserKhalil

Well-Known Member
Thank you very much for great code. I tried to follow the code using F8 to get the whole process

Can I do the macro existing in SeeSomething & SaySomething from the workbook "MyProject.xlsm" itself ..?
The whole idea >> is to put a code in workbook open event that compares the version of the existing "MyProject.xlsm" with a version number stored on a Google Document then if the number on the Google Document is greater than the current version, then to download the newer version to specific path (this path will be the source path of the new files) >>>>>

Now the user who uses the old version have the old "MyPorject.xlsm" open >> so I need to execute your macro from the old workbook that is open now and do the process .. Is that possible??

I will upload the file "MyProject.xlsm" ...
Please have a look >> don't update so click No to avoid update process now and have a look at the code in workbook open event
Close the workbook and open it again to update the workbook . I have commented the lines that used the vbs file to do the task
My target now is to implement the macros you have offered into this "MyProject.xlsm" so as to do the same task of the vbs file

Thanks a lot for your interest
 

Attachments

Marc L

Excel Ninja
Hi !​
Is it possible to do that without the vbs file??
Yes if the code is not located in the active workbook, the code must close it before to operate …​

compares the version of the existing "MyProject.xlsm" with a version number stored on a Google Document
Do you already know how to reach any Google Document from VBA ? Far away from initial post & VBScript …​
 

YasserKhalil

Well-Known Member
Yes I could somewhat reach the Google Document .. I have posted the code in MyProject file ..
I wish I can find a way to do the copy and the replace of the old version with the new version without the need of the vbs file ..
 

Marc L

Excel Ninja
I have posted the code in MyProject file ..
If it's the active workbook I do not think it could work​
or as I wrote in post #9 « if the code is not located in the active workbook, the code must close it before to operate »​
after checking the versions # then it's easy to do the copy and the replace of the old version with the new version
without using any VBScript file …​
 

YasserKhalil

Well-Known Member
So can you post example files so as to get the idea ..? I am totally stuck at this point as I didn't experiment such thing before
 

YasserKhalil

Well-Known Member
This is what I have reached .. The password is 123 for the "MyFiles.zip" file that is downloaded from Google Drive
Now when there is a new version the files are downloaded and this workbook "MyProject.xlsm" is closed and Helper Workbook will be opened instead ..
Can you help me with the code that do the process of copy and replace ..?
 

Attachments

YasserKhalil

Well-Known Member
This Helper Workbook will be within the files that I will download later .. but now suppose that Helper Workbook in the same path of MyProject.xlsm
Now the file MyProject.xlsm is closed so it is possible to do the copy and replace process ...
The old workbook is "MyProject.xlsm" that was active and closed
The new workbook is "MyProject.xlsm" that is in "C:\ProgramData\MyFolder" ..

I need to put a code in the "Helper Workbook" in workbook_open event that finishes the task...
 

Marc L

Excel Ninja
  • At the top of your procedure create a constant for the new file full path and a string variable for the active workbook like

    Const N = "C:\ProgramData\MyFolder\MyProject.xlsm"
    Dim F$

  • Store the active workbook full name before closing it like F = ActiveWorkbook.FullName

  • So to copy the new file to the closed 'active workbook' : If Dir(N) > "" Then CreateObject("Scripting.FileSystemObject").CopyFile N, F
    as Kenneth already showed you …
 

YasserKhalil

Well-Known Member
These two lines should be put in the old "MyProject.xlsm" workbook in module1 or in the "Helper Workbook.xlsm" workbook?
Code:
Const N = "C:\ProgramData\MyFolder\MyProject.xlsm"
Dim F$
And what about this line too
Code:
F = ActiveWorkbook.FullName
I am confused about explanation as I will have two activeworkbooks ..
 

Marc L

Excel Ninja
As Excel has only a single active workbook whatever with only one or several workbooks opened …​
So you use the term 'active workbook' but seems to be different of an Excel active workbook so that's confusing any helper !​
Again, the procedure can't be located in the old workbook as it must be closed during the execution.​
So whatever if the old workbook is the active one or not as it must be closed and its full name saved before …​
 

Marc L

Excel Ninja
I'm confused too as my answers follow your explanations …​
So you must well describe the context - crystal clear & complete - but obviously​
  • the procedure can't be executed from the old workbook
  • if the old workbook is opened, it must be closed before the copy
  • use the CopyFile method like explained in the VBA inner help and like used by Kenneth & I …
 

YasserKhalil

Well-Known Member
In the Helper Workbook I put this in module 1
Code:
Option Explicit

Public Const n = "C:\ProgramData\MyFolder\MyProject.xlsm"
Public f As String
And in workbook_open event
Code:
Option Explicit

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    f = ThisWorkbook.Worksheets(1).Range("Z1").Value
    If Dir(n) > "" Then CreateObject("Scripting.FileSystemObject").CopyFile n, f
    Workbooks.Open (f)
    
    With ThisWorkbook
        .Save
        .ChangeFileAccess Mode:=xlReadOnly
        Kill .FullName
        .Close SaveChanges:=False
    End With
End Sub
This I think would solve the problem. Am I right?
I welcome any other observations
 

Marc L

Excel Ninja
  • As I wrote « the constant and the variable in the top of the procedure » so why Public in another module ?!

  • As again you can't 'kill' an opened workbook, did you run this event ? …
 

YasserKhalil

Well-Known Member
I have updated the code in MyProject.xlsm workbook_open event like that

Code:
Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim currVer             As Single
Dim strOldWorkbook      As String

Private Sub Workbook_Open()
    Dim objReq          As MSXML2.ServerXMLHTTP60
    Dim wbHelper        As Workbook
    Dim dlPath          As Variant
    Dim oApp            As Object
    Dim strResponse     As String
    Dim strCopyTo       As String
    Dim strCurrPath     As String
    Dim strCopyFrom     As String
    Dim sFile           As String
    Dim wbHelpPath      As String
    
    Const sURL      As String = "https://docs.google.com/document/d/e/2PACX-1vSnj9bynjBnlLyr60ExmmXWD1b-_qgfatglmDhLhIQaHM_8EvXC0zucOsWlLIlSfhyDUuuAWrRhWnF7/pub"
    
    dlPath = Environ("PROGRAMDATA") & "\MyFolder\"
    sFile = "MyFiles.zip"
    If Len(Dir(dlPath & "*.*")) > 0 Then Kill dlPath & "*.*"
    If Len(Dir(dlPath, vbDirectory)) = 0 Then MkDir dlPath
    currVer = 0.5
    Set objReq = New ServerXMLHTTP60

    With objReq
        .Open "GET", sURL, False
        .send
        If .Status = 200 Then
            strResponse = .responseText
            If Val(Trim(Split(Split(strResponse, "Version:")(1), "</span>")(0))) > currVer Then
                If MsgBox("You Have Newer Version. Would You Like To Download It?", vbYesNo + vbQuestion) = vbYes Then
                    URLDownloadToFile 0, Trim(Split(Split(strResponse, "Link:")(1), "</span>")(0)), dlPath & sFile, 0, 0
                    
                    Set oApp = CreateObject("Shell.Application")
                    oApp.Namespace(dlPath).CopyHere oApp.Namespace(dlPath & sFile).items
                    strOldWorkbook = ThisWorkbook.FullName
                    
                    wbHelpPath = dlPath & "\TempWorkbook.xlsm"
                    If Dir(wbHelpPath) > "" Then
                        Set wbHelper = Workbooks.Open(wbHelpPath)
                        wbHelper.Worksheets(1).Range("Z1").Value = strOldWorkbook
                        ThisWorkbook.Close False
                    Else
                        MsgBox "Update Not Completed. Make Sure " & wbHelper & " Exists", vbCritical
                    End If
                End If
            End If
        End If
        .abort
    End With
End Sub
I have used the variable strOldWorkbook to store the path of the old project and put it in the helper workbook in Z1
Code:
wbHelper.Worksheets(1).Range("Z1").Value = strOldWorkbook
This works well till now .. But I am surprised why Z1 in the helper column is empty ...and so I got an error on workbook_open event in the helper workbook
 

YasserKhalil

Well-Known Member
I have discovered the problem. I have to disable to workbook_open event in the helper workbook so as to be able put the value of the full path of the old workbook into Z1 in helper workbook
so I am use
Code:
                        Application.Enablevents = False
                            Set wbHelper = Workbooks.Open(wbHelpPath)
                            wbHelper.Worksheets(1).Range("Z1").Value = strOldWorkbook
                        Application.Enablevents = True
But at the same time I would like to trigger the event of workbook open event in the helper workbook

Hope the problem is clear now
 

Marc L

Excel Ninja
Near to a gas factory code ! Maybe Kenneth will have an idea, for the moment​
I see only an ADO connection to write to cell Z1 of the helper workbook before to open it …​
… or instead to write in a cell just create a temporary text file or via the Windows registry , easy …​
If I'll have to find back the VBA ghost space but since a very long time I did not use it.​
 
Top