Hello I have VBA which works perfectly, however it has been moved to a synced SharePoint folder and now doesn’t work. Any thoughts
Sub CopyToMaster(FullName As String)
'Declare some variables
Dim fso As Object, fldr As Object, fl As Object
Dim cc As Range
Dim sht As Worksheet
Dim InRegister As String
Dim nr As Long
'Turn off Screen Updating
Application.ScreenUpdating = False
'Create objects to work with File System
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(ThisWorkbook.Path)
'Set Number of first output row in Invoice
nr = 13
'// Loop through each file in the folder whos name begins with "Register_"
'// and then search Range B8:B128 of each sheet in those files for the value
'// passed in as FullName
myCheck_FullName_Exist = 0 'the 1st line to add
For Each fl In fldr.Files
If InStr(fso.GetBaseName(fl), "Register_") Then
With Workbooks.Open(fl.Path, True, True)
For Each sht In .Sheets
For Each cc In sht.Range("B8:B172")
If Join(Array(cc.Value, cc.Offset(, -1).Value), " ") = FullName Then
myCheck_FullName_Exist = 1 'the 2nd line to add
With ThisWorkbook
.Activate
'// Fill out the Invoice with information found in the files
With .Sheets("Invoice")
.Activate
.Range("B9") = FullName '// INSERT NAME UNDER BILL TO
.Range("B" & nr).Select '// SELECT FIRST OUTPUT ROW
With ActiveCell
.Value = sht.Range("A2") '// DESCRIPTION
.Offset(, 1) = sht.Range("O" & cc.Row) '// NO. OF SESSIONS
InRegister = Left(.Value, Len(.Value) - (Len(.Value) - InStrRev(.Value, " Week") + 1))
.Offset(, 2) = Sheets("Home").Range("CostPerSession").Find(What:=InRegister, LookIn:=xlValues).Offset(, 1) '// COST PER SESSION
.Offset(1).Select '// MOVE DOWN ONE ROW
End With
End With
End With
nr = nr + 1
Exit For
End If
Next cc
Next sht
.Close _
SaveChanges:=False
End With
End If
Next fl
If myCheck_FullName_Exist = 1 Then 'the 3rd line to add
'// Save Invoice
SaveInvWithNewName
Else 'the 4th line to add
MsgBox "The pupil " & FullName & " not found." 'the 5th line to add
End If 'the 6th line to add
'// Turn on Screen Updating
Application.ScreenUpdating = True
End Sub
VBA Code:
'Declare some variables
Dim fso As Object, fldr As Object, fl As Object
Dim cc As Range
Dim sht As Worksheet
Dim InRegister As String
Dim nr As Long
'Turn off Screen Updating
Application.ScreenUpdating = False
'Create objects to work with File System
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(ThisWorkbook.Path)
'Set Number of first output row in Invoice
nr = 13
'// Loop through each file in the folder whos name begins with "Register_"
'// and then search Range B8:B128 of each sheet in those files for the value
'// passed in as FullName
myCheck_FullName_Exist = 0 'the 1st line to add
For Each fl In fldr.Files
If InStr(fso.GetBaseName(fl), "Register_") Then
With Workbooks.Open(fl.Path, True, True)
For Each sht In .Sheets
For Each cc In sht.Range("B8:B172")
If Join(Array(cc.Value, cc.Offset(, -1).Value), " ") = FullName Then
myCheck_FullName_Exist = 1 'the 2nd line to add
With ThisWorkbook
.Activate
'// Fill out the Invoice with information found in the files
With .Sheets("Invoice")
.Activate
.Range("B9") = FullName '// INSERT NAME UNDER BILL TO
.Range("B" & nr).Select '// SELECT FIRST OUTPUT ROW
With ActiveCell
.Value = sht.Range("A2") '// DESCRIPTION
.Offset(, 1) = sht.Range("O" & cc.Row) '// NO. OF SESSIONS
InRegister = Left(.Value, Len(.Value) - (Len(.Value) - InStrRev(.Value, " Week") + 1))
.Offset(, 2) = Sheets("Home").Range("CostPerSession").Find(What:=InRegister, LookIn:=xlValues).Offset(, 1) '// COST PER SESSION
.Offset(1).Select '// MOVE DOWN ONE ROW
End With
End With
End With
nr = nr + 1
Exit For
End If
Next cc
Next sht
.Close _
SaveChanges:=False
End With
End If
Next fl
If myCheck_FullName_Exist = 1 Then 'the 3rd line to add
'// Save Invoice
SaveInvWithNewName
Else 'the 4th line to add
MsgBox "The pupil " & FullName & " not found." 'the 5th line to add
End If 'the 6th line to add
'// Turn on Screen Updating
Application.ScreenUpdating = True
End Sub