Updating another workbook
Hi there,
I have some remarks to start with
For starters may I suggest you put the names of the employees on
sheet2.
You should keep in mind that an employee may have his/her personal
workbook in use when the boss tries to update it.
So copy all questions every time the update proces is running.
It might be something like:
' --------- Start of code
Sub UpdateEmployeeSheets()
Dim strFolder As String
Dim strFile As String
Dim lngRow As Long
Dim intPos As Integer
Dim wbkEmployee As Workbook
Dim strSource As String
' Find the path to the folder
strFolder = ThisWorkbook.FullNameURLEncoded
intPos = InStrRev(strFolder, "\")
strFolder = Left(strFolder, intPos)
lngRow = 2
Do
ThisWorkbook.Sheets("Sheet1").UsedRange.Copy
strFile = strFolder &
ThisWorkbook.Worksheets("Sheet2").Cells(lngRow, 1).Value
On Local Error Resume Next
Set wbkEmployee = Application.Workbooks.Open(strFile, False,
False)
If Err.Number 0 Then
ThisWorkbook.Worksheets("Sheet2").Cells(lngRow, 2).Value =
"In use"
Else
wbkEmployee.Sheets("Sheet1").Select
wbkEmployee.Sheets("Sheet1").Range("A1").Select
wbkEmployee.Sheets("Sheet1").Paste
ThisWorkbook.Worksheets("Sheet2").Cells(lngRow, 2).Value =
"Updated"
wbkEmployee.Close True
End If
lngRow = lngRow + 1
Loop Until IsEmpty(ThisWorkbook.Worksheets("Sheet2").Cells(ln gRow,
1))
Application.CutCopyMode = False
End Sub
'---- End of listing
If you copy this and get some red lines in you code just concatenate
those to a single line.
HTH,
Wouer
|