View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Wouter HM Wouter HM is offline
external usenet poster
 
Posts: 99
Default 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