Copy master sheet into multiple workworks from remote location

[jaminben]

Hi,

Not sure if this is outta my league being a noob vba'er so I'm just testing the water with this question to see how hard it would be.

Anyway, a little background first. We have 10+ engineers who each have an excel workbook which they use to complete jobs. Each workbook has a sheet which we refer to as a typical defect sheet and each engineer uses this sheet to enter electrical defects for properties we test. We use this typical defect sheet to ensure each engineers wording of defects remains constant across multiple jobs.

As time goes on we update the typical defects sheet with new defects and then have to issue each engineer the new workbook. This isn't a massive issue except for large jobs which are running at the time we want to issue a new workbook.

So I was thinking why don't we keep a master copy of this sheet on our work server, add a button to the workbook and have the typical defects sheet be updated or replaced with this master copy.

How hard would this be? Can anyone point me in the right direction? Would it be easier to delete the old defects sheet then insert the new master sheet?

I've search google and these forums and found several similar examples but nothing that fully matches my needs.

Sorry for the long post and hopefully I've explained what I'd like to achieve.

Thanks

Ben

[mdmackillop]

A couple of questions
Will other sheets refer to this Master Sheet in formulae?
Will the order of items change, or are you just appending to the bottom of a list.
It's simple enough to write new values, or to replace the sheet, but either might upset things depending upon your use.
Can you post a sample workbook to demonstrate how the data is used?

[jaminben]

Hi mdmackillop,

Unfortunatlly I'm not able to post the workbook (so I've been told) which is probably bad form but my hands are tied in that respect.

The sheet doesn't have any formulas and its purly used to generate list boxes within a user form which the engineers use to select the defects (two list boxes, one for category and the other for defect titles... it also has a search defect id code column as well). I then iterate through the sheet grouping each defect into categories to populate the list boxes.

The only issue that I can think of is that I've used ranges to specify the start of each column but I can soon change that to just use a cell reference which wont ever change.

I'm currently debating if I should download the master sheet into a temp directory once the update button has been hit then delete the old sheet and add the new.... I think the hardest problem for me would be to connect to the server to grab the new workbook/sheet. The reason I'm thinking of downloading the sheet is I believe the workbook that contains this one sheet will need to be opened on each laptop that needs to updated and I'm not sure what will happen if two engineers try to update at the sametime.

Thanks

Ben

[jaminben]

Ok so my thinking is to first test what the last modified date of the master sheet on the server would be and to compare that against a stored record of the last modified master sheet in the engineers workbook. If the master sheet is newer than the stored value then:
1. Go ahead and download the file into a temp directory
2. Rename the old sheet
3. Move the new sheet into the workbook
4. Delete the old sheet if the process completes without any issues
5. Add the new last modified date to the workwork ready for the next update
6. Delete the file from the temp folder
7. All done (fingers crossed)

Here's the start of the code using a dummy shared folder on my desktop... anyone see any issues with the above idea and my code so far? (I'm not sure how its pulling in the last modified file as theirs several files in that folder but it always prints the newest version, not sure if its luck or pure chance).

Private Function List_All_Files() As String

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder("\\WIN7\Test (file://\\WIN7\Test) Share\")

For Each objFile In objFolder.Files

List_All_Files = objFile.Name

Next

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Function
Private Function Get_Last_Modified_Date() As String
Dim oFS As Object
Dim strFilename As String

strFilename = "\\WIN7\Test (file://\\WIN7\Test) Share\" & List_All_Files
Set oFS = CreateObject("Scripting.FileSystemObject")

Get_Last_Modified_Date = oFS.GetFile(strFilename).Datelastmodified
Set oFS = Nothing
End Function
Sub Get_File_Date()
Debug.Print "Get_Last_Modified_Date: " & Get_Last_Modified_Date
End Sub

Thanks

Ben

[mdmackillop]

Something like this is unlikely to be open long enough to cause a conflict

Sub Test()
Dim wb As Workbook
Dim sht As Worksheet
Set sht = Sheet1
Set wb = Workbooks.Open("C:\Downloads\Data.xlsm", False, True)
wb.Sheets(1).Cells.Copy sht.Cells(1, 1)
wb.Close False
End Sub

[jaminben]

Ok, thanks.

Out of curiosity would you add:

Set sht = Nothing
Set wb = Nothing


At the end as well? I've read that this is to clear the memory but not sure if its the correct thing to do in all cases.

Thanks

Ben

[mdmackillop]

It would do no harm, but I understand memory should be released in any case.

[jaminben]

It would do no harm, but I understand memory should be released in any case.

Ah, at the end with the "End Function" it clears the memory? I read it does this with "End Sub" as well.

I've attached my latest code below... any tips or improvents would be most welcome:

Option Explicit
Private Function Get_Remote_Server_Lastest_Modified_File() As String

Dim currStrFilename As String
Dim lastStrFileName As String
Dim lastFileDate As String
Dim currFileDate As String
Dim RemoteServer As String
Dim File As String

Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Dim i As Integer

RemoteServer = "\\SAGESERVER\Test (file://\\SAGESERVER\Test) Share\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(RemoteServer)

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

i = 0

For Each objFile In objFolder.Files

If InStr(objFile.Name, ".xlsm") Then
If i < 1 Then

i = i + 1

File = objFile.Name

Else

i = i + 1

currStrFilename = RemoteServer & objFile.Name

lastStrFileName = RemoteServer & File

currFileDate = objFSO.GetFile(currStrFilename).Datelastmodified
lastFileDate = objFSO.GetFile(lastStrFileName).Datelastmodified

If DateValue(currFileDate) > (lastFileDate) Then

File = objFile.Name

End If

End If

End If

Next

Get_Remote_Server_Lastest_Modified_File = RemoteServer & File

Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Function
Private Function Is_Remote_Server_File_Newer_Than_Current_File() As Boolean
Dim CurrentFileModificationDate As String
Dim RemoteModificationDate As String

Dim objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
CurrentFileModificationDate = Sheets("Typical Defects").Range("Typical_Defects_Last_Modified_Date").Value
RemoteModificationDate = objFSO.GetFile(Get_Remote_Server_Lastest_Modified_File).Datelastmodified

'-----------------------------------------------------------------------------
'I don't think what's below is the best way to define a Boolean value any tips?

If DateValue(RemoteModificationDate) > (CurrentFileModificationDate) Then

Sheets("Typical Defects").Range("Typical_Defects_Last_Modified_Date") = RemoteModificationDate

Is_Remote_Server_File_Newer_Than_Current_File = True

Else

Is_Remote_Server_File_Newer_Than_Current_File = False

End If

'-----------------------------------------------------------------------------

Set objFSO = Nothing
End Function
Sub Download_File_If_Needed()
Dim RemoteModificationDate As String
If Is_Remote_Server_File_Newer_Than_Current_File Then
If Len(Dir("c:\Facit Temp\", vbDirectory)) = 0 Then

MkDir "c:\Facit Temp\"

End If

FileCopy Get_Remote_Server_Lastest_Modified_File, "c:\Facit Temp\Latest Typical Defects.xlsm"

Debug.Print "File is updating"
Debug.Print "RemoteModificationDate: " & RemoteModificationDate ' <--------- How can I pass this from the previous Function as well as the true false Boolean value
Else
Debug.Print "File is already upto date"
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

I'm making slow progress but it all seems to be working apart from pulling in the RemoteModificationDate part.
I also need to add in some error handling to check if a file exists and I guess something to determin if the connection to the remote server has died.

Thanks

Ben