ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Network problem (https://www.excelbanter.com/excel-programming/395997-network-problem.html)

Oldjay

Network problem
 
I have a program C:\Qoutes\qq2.xls
I have the original for this workbook at \\server3\Quotes\qq2.xls
I update this workbook almost weekly.
I them email everybody to download the updated version.

Is there away that I can have an input box that asked "Do you want to check
for an update?" and if there is a newer version download it?

oldjay

Incidental

Network problem
 
Hi oldjay

This method is perhaps not the easiest or cleanest way round your
problem though it should work for your problem it works by checking
the vbproject description against a single line textfile if the values
match you have the latest version if not another workbook is opened
that will close the book "qq2.xls" and run the code to copy the latest
version from the server.

to set this up create a notepad text file and place it in the same
directory as your latest version of the workbook "\\server3\Quotes
\qq2.xls" in this file write your version number i.e. "1.2.3"

In the local directory "C:\Qoutes\" create a new workbook and add the
2 modules to it then paste the following code in to them.

'module1
'this code will switch between workbooks so the file you want to
update isn't open when you update

Option Explicit

Sub CloseMyApp(inBook As Workbook) 'Close MyApp workbook then run the
updater sub
Application.OnTime Now + TimeValue("00:00:02"), "Install_Update"
inBook.Close False
End Sub

'module2
'this code will copy the latest version to the local computer

Option Explicit
Dim ObjFso As Object
Dim Copy_Dir As String
Dim Paste_Dir As String

Sub Install_Update()

Copy_Dir = "\\server3\Quotes" 'Pass location to a string

Paste_Dir = "C:\Qoutes" 'Pass destination to a string

Set ObjFso = CreateObject("Scripting.FileSystemObject")

ObjFso.CopyFolder Copy_Dir, Paste_Dir 'Copy the
contacts system to the local drive

MsgBox "My Application" & vbNewLine & "Has Been Updated" &
vbNewLine & _
"Please restart My Application", vbOKOnly, "DownLoaded"

ActiveWorkbook.Saved = True 'Ensure Excel doesn't ask to save
the workbook

Set ObjFso = Nothing

Application.Quit 'Quit Excel

End Sub

Then in your main workbook "qq2.xls" you should add your version
number to the vbproject description (under VBA project properties from
the tools menu of VBE)

Once you have set your version number make sure your textfile has the
same version number and then in the workbook open module of qq2.xls
add the following code.

Option Explicit

Dim ObjFSO As Object
Dim ObjTxt As Object
Dim TxtVal As String
Const TxtChk = "\\server3\Quotes\New Text Document.txt"
Const ForReading = 1

Private Sub Workbook_Open()

Dim Msg, Style, Title, Response

Msg = "Do you want to check for an update?"
Style = vbYesNo + vbDefaultButton2
Title = "Check for Update"

Response = MsgBox(Msg, Style, Title)

If Response = vbYes Then

Set ObjFSO = CreateObject("Scripting.FileSystemObject")

Set ObjTxt = ObjFSO.OpenTextFile(TxtChk, ForReading)

TxtVal = ObjTxt.ReadLine

ObjTxt.Close

If TxtVal = ThisWorkbook.VBProject.Description Then

MsgBox ("Current version is up to date")

Exit Sub

Else
'Load updater workbook
Workbooks.Open ("C:\Qoutes\Updater.xls")
'Run the sub to close this workbook
Application.Run "'Updater.xls'!CloseMyApp", ThisWorkbook

End If

Else

Exit Sub

End If

End Sub

And that should be it. It will take a bit of manual work to get the
files onto the local machines but from then on it should be a matter
of you updating the file CHANGING BOTH VERSION NUMBERS vbproject
description and the text file then the user should be able to update
it for themselves. You will have to tinker with the code I'm sure to
get it to fit with your specific needs and I'm sure that the directory
information will need to be checked. I recommend that you test the
code first before using as it will copy over the qq2.xls file without
prompt.

Any how I hope this is of some help to you

S





Oldjay

Network problem
 
Need a little or maybe a lot guidance. I have written all the code.
AS far as your statement "you should add your version
number to the vbproject description (under VBA project properties from
the tools menu of VBE)"


I opened Tools - Master.xls properties and under Project description I put
my version (2.2a) I then ran the Wookbook_Open - it stopped at

If TxtVal = ThisWorkbook.VBProject.Description Then

I hovered over TxtVal it was "2.2a" which is correct but the other side of
the= sign said

"ThisWorkbook.vbproject.de...= <object variable or with block not set

I don't know what is the problem

oldjay

"Incidental" wrote:

Hi oldjay

This method is perhaps not the easiest or cleanest way round your
problem though it should work for your problem it works by checking
the vbproject description against a single line textfile if the values
match you have the latest version if not another workbook is opened
that will close the book "qq2.xls" and run the code to copy the latest
version from the server.

to set this up create a notepad text file and place it in the same
directory as your latest version of the workbook "\\server3\Quotes
\qq2.xls" in this file write your version number i.e. "1.2.3"

In the local directory "C:\Qoutes\" create a new workbook and add the
2 modules to it then paste the following code in to them.

'module1
'this code will switch between workbooks so the file you want to
update isn't open when you update

Option Explicit

Sub CloseMyApp(inBook As Workbook) 'Close MyApp workbook then run the
updater sub
Application.OnTime Now + TimeValue("00:00:02"), "Install_Update"
inBook.Close False
End Sub

'module2
'this code will copy the latest version to the local computer

Option Explicit
Dim ObjFso As Object
Dim Copy_Dir As String
Dim Paste_Dir As String

Sub Install_Update()

Copy_Dir = "\\server3\Quotes" 'Pass location to a string

Paste_Dir = "C:\Qoutes" 'Pass destination to a string

Set ObjFso = CreateObject("Scripting.FileSystemObject")

ObjFso.CopyFolder Copy_Dir, Paste_Dir 'Copy the
contacts system to the local drive

MsgBox "My Application" & vbNewLine & "Has Been Updated" &
vbNewLine & _
"Please restart My Application", vbOKOnly, "DownLoaded"

ActiveWorkbook.Saved = True 'Ensure Excel doesn't ask to save
the workbook

Set ObjFso = Nothing

Application.Quit 'Quit Excel

End Sub

Then in your main workbook "qq2.xls" you should add your version
number to the vbproject description (under VBA project properties from
the tools menu of VBE)

Once you have set your version number make sure your textfile has the
same version number and then in the workbook open module of qq2.xls
add the following code.

Option Explicit

Dim ObjFSO As Object
Dim ObjTxt As Object
Dim TxtVal As String
Const TxtChk = "\\server3\Quotes\New Text Document.txt"
Const ForReading = 1

Private Sub Workbook_Open()

Dim Msg, Style, Title, Response

Msg = "Do you want to check for an update?"
Style = vbYesNo + vbDefaultButton2
Title = "Check for Update"

Response = MsgBox(Msg, Style, Title)

If Response = vbYes Then

Set ObjFSO = CreateObject("Scripting.FileSystemObject")

Set ObjTxt = ObjFSO.OpenTextFile(TxtChk, ForReading)

TxtVal = ObjTxt.ReadLine

ObjTxt.Close

If TxtVal = ThisWorkbook.VBProject.Description Then

MsgBox ("Current version is up to date")

Exit Sub

Else
'Load updater workbook
Workbooks.Open ("C:\Qoutes\Updater.xls")
'Run the sub to close this workbook
Application.Run "'Updater.xls'!CloseMyApp", ThisWorkbook

End If

Else

Exit Sub

End If

End Sub

And that should be it. It will take a bit of manual work to get the
files onto the local machines but from then on it should be a matter
of you updating the file CHANGING BOTH VERSION NUMBERS vbproject
description and the text file then the user should be able to update
it for themselves. You will have to tinker with the code I'm sure to
get it to fit with your specific needs and I'm sure that the directory
information will need to be checked. I recommend that you test the
code first before using as it will copy over the qq2.xls file without
prompt.

Any how I hope this is of some help to you

S






Incidental

Network problem
 
HI Oldjay

I'm not sure what the issue is there? What version of excel are you
running? i'm running office 2003 on XP and the code works on that
format though i can't say if it will work on any of the others
you could try adding the line below to the code just before the line
that is giving the error

Debug.Print ThisWorkbook.VBProject.Description

If your get 2.2a showing up in the immediate view then i may be
stumped as to why that is happening? a work around may be to add your
version number to a hidden sheet in your workbook then check against
that i.e.if TxtVal =Sheets(3).[A1].Value Then ' with sheet3 set to
xlsheethidden) other than that if nothing is showing in the immediate
view after the debug.print line ensure that you have added the version
number to the same workbook as you are running the "workbook_open"
sub.

let me know how you get on.

S





Oldjay

Network problem
 
I am running 2003 in XP
I got by this problem by checking"Trust access to VB Projects "in Security.

I now have another problem.
When Install_Update() runs it hangs at

ObjFso.CopyFolder Copy_Dir, Paste_Dir . Displaying "Path not found"

I have hovered over Copy_Dir and Copy_Dir and they seemed to have the
correct paths.
Any suggestings

oldjay


"Incidental" wrote:

HI Oldjay

I'm not sure what the issue is there? What version of excel are you
running? i'm running office 2003 on XP and the code works on that
format though i can't say if it will work on any of the others
you could try adding the line below to the code just before the line
that is giving the error

Debug.Print ThisWorkbook.VBProject.Description

If your get 2.2a showing up in the immediate view then i may be
stumped as to why that is happening? a work around may be to add your
version number to a hidden sheet in your workbook then check against
that i.e.if TxtVal =Sheets(3).[A1].Value Then ' with sheet3 set to
xlsheethidden) other than that if nothing is showing in the immediate
view after the debug.print line ensure that you have added the version
number to the same workbook as you are running the "workbook_open"
sub.

let me know how you get on.

S






Oldjay

Network problem
 
Thanks I found the problem had backward \ at the end of The Copy_Dir path

Thanks for all the help

"Incidental" wrote:

HI Oldjay

I'm not sure what the issue is there? What version of excel are you
running? i'm running office 2003 on XP and the code works on that
format though i can't say if it will work on any of the others
you could try adding the line below to the code just before the line
that is giving the error

Debug.Print ThisWorkbook.VBProject.Description

If your get 2.2a showing up in the immediate view then i may be
stumped as to why that is happening? a work around may be to add your
version number to a hidden sheet in your workbook then check against
that i.e.if TxtVal =Sheets(3).[A1].Value Then ' with sheet3 set to
xlsheethidden) other than that if nothing is showing in the immediate
view after the debug.print line ensure that you have added the version
number to the same workbook as you are running the "workbook_open"
sub.

let me know how you get on.

S







All times are GMT +1. The time now is 02:09 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com