Hi All,

Below is the code l am writing to update 60 workbooks. No problems with
the functions or Item 1

However when the code gets to Item 2 it crashes when it gets to removing
"CreateUniqueItems"

Can anybody help me correct the code please?

Also Item 3 deletes and inserts a userfrom. I assume that VBA treats this VB
Component the same as a module and that the same code can be used. Is this
correct and if not what code should be used?

Sorry about the amount of comments

All suggestions gratefully received.

The FILE NAME ONLY function
Public Function FileNameOnly(pname) As String
' Returns the filename from a path/filename string
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = Application.PathSeparator Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'Function to unlock VBA Project if password is known

Dim VBP As VBProject, oWin As VBIDE.Window
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection < vbext_pp_locked Then Exit Sub

Application.ScreenUpdating = True

'Close any code windows to ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") 0 Then oWin.Close
Next oWin
WB.Activate

' Now use lovely SendKeys to unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

'Check to see if project unlocked
If VBP.Protection = vbext_pp_locked Then
' if failed - maybe wrong password
SendKeys "%{F11}%TE", True
End If

' Leave no evidence of the password
Password = ""

' Go back to the previously active workbook
wbActive.Activate

End Sub


Sub UnprotectProjectandImportVBAmodule()

'This macro imports a selected VBA Module, imports it to a
'selected Excel "Target" file, then runs the macro contained
'in the imported VBA Module.

Dim VBsourceFp As String 'Source VBA module name & path
Dim VBsourceFn As String 'Source VBA module filename
Dim TargetFp As String 'Target Excel file name & path
Dim TargetFn As String 'Target Excel filename

Application.ScreenUpdating = False
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to Import -
STP.bas", , False)
TargetFp = Application.GetOpenFilename(, , "Select Excel 'Target' File", ,
False)

'### ITEM 1 - Import STP Figures
################################################## ##########

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'STP' enhancement."
'Open Target file.
Workbooks.Open (TargetFp)
'Extract filename only from path
TargetFn = FileNameOnly(TargetFp)
'Use function to unprotect VBA Project
UnprotectVBProject Workbooks(TargetFn), "jordan"
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp
'Activate target workbook
Workbooks(TargetFn).Activate
'Run macro residing in target workbook
Run TargetFn & "!Process"

'### ITEM 2 - Retain Forecast Figures
###########################################

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'Retain Forecast Figures'
enhancement."
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to Import -
CreateUniqueList.bas", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove ("CreateUniqueList")
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp

'### ITEM 3 - Check Form
################################################## ######

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'Check Form' enhancement."
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to Import -
csvwarning.frm", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove VBsourceFnComp
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to Import -
costscsv.bas", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove VBsourceFnComp
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp

'Inform user
MsgBox ("Enhancements have been applied to the target file and STP figures
have been imported. Please check the file for accuracy then save and close
file.")
End Sub

Regards

Michael Beckinsale

Hi all,

Have now solved the problem by adding a variable

Dim VBComp As VBComponent

then for item that needs removing

Set VBComp = Workbooks(TargetFn).VBProject.VBComponents("Create UniqueList")
Workbooks(TargetFn).VBProject.VBComponents.Remove VBComp

Apologies if anybody has spent any time on this.

Regards

Michael beckinsale




"Michael Beckinsale" wrote in message
...
Hi All,

Below is the code l am writing to update 60 workbooks. No problems with
the functions or Item 1

However when the code gets to Item 2 it crashes when it gets to removing
"CreateUniqueItems"

Can anybody help me correct the code please?

Also Item 3 deletes and inserts a userfrom. I assume that VBA treats this
VB Component the same as a module and that the same code can be used. Is
this correct and if not what code should be used?

Sorry about the amount of comments

All suggestions gratefully received.

The FILE NAME ONLY function
Public Function FileNameOnly(pname) As String
' Returns the filename from a path/filename string
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = Application.PathSeparator Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'Function to unlock VBA Project if password is known

Dim VBP As VBProject, oWin As VBIDE.Window
Dim wbActive As Workbook
Dim i As Integer
Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection < vbext_pp_locked Then Exit Sub

Application.ScreenUpdating = True

'Close any code windows to ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") 0 Then oWin.Close
Next oWin
WB.Activate

' Now use lovely SendKeys to unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

'Check to see if project unlocked
If VBP.Protection = vbext_pp_locked Then
' if failed - maybe wrong password
SendKeys "%{F11}%TE", True
End If

' Leave no evidence of the password
Password = ""

' Go back to the previously active workbook
wbActive.Activate

End Sub


Sub UnprotectProjectandImportVBAmodule()

'This macro imports a selected VBA Module, imports it to a
'selected Excel "Target" file, then runs the macro contained
'in the imported VBA Module.

Dim VBsourceFp As String 'Source VBA module name & path
Dim VBsourceFn As String 'Source VBA module filename
Dim TargetFp As String 'Target Excel file name & path
Dim TargetFn As String 'Target Excel filename

Application.ScreenUpdating = False
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to
Import - STP.bas", , False)
TargetFp = Application.GetOpenFilename(, , "Select Excel 'Target' File", ,
False)

'### ITEM 1 - Import STP Figures
################################################## ##########

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'STP' enhancement."
'Open Target file.
Workbooks.Open (TargetFp)
'Extract filename only from path
TargetFn = FileNameOnly(TargetFp)
'Use function to unprotect VBA Project
UnprotectVBProject Workbooks(TargetFn), "jordan"
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp
'Activate target workbook
Workbooks(TargetFn).Activate
'Run macro residing in target workbook
Run TargetFn & "!Process"

'### ITEM 2 - Retain Forecast Figures
###########################################

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'Retain Forecast Figures'
enhancement."
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to
Import - CreateUniqueList.bas", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove ("CreateUniqueList")
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp

'### ITEM 3 - Check Form
################################################## ######

'Inform user what is happening
Application.StatusBar = "Please wait....Applying 'Check Form'
enhancement."
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to
Import - csvwarning.frm", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove VBsourceFnComp
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp
'Select VBA module to import
VBsourceFp = Application.GetOpenFilename(, , "Select VBA Module to
Import - costscsv.bas", , False)
'Extract filename only from path
VBsourceFn = FileNameOnly(VBsourceFp)
'Delete existing VBA module from target workbook
Workbooks(TargetFn).VBProject.VBComponents.Remove VBsourceFnComp
'Import required VBA Module to target workbook
Workbooks(TargetFn).VBProject.VBComponents.Import Filename:=VBsourceFp

'Inform user
MsgBox ("Enhancements have been applied to the target file and STP figures
have been imported. Please check the file for accuracy then save and close
file.")
End Sub

Regards

Michael Beckinsale