View Full Version : InsertVBComponent not working
Drake1986
08-12-2021, 11:27 PM
Good day all.
To say I am frustrated is an understatement. I am pulling my hair out. I have a piece of code that works when I run it manually via the VBA enviroment works, but as soon as I need it to run by itself it just does not run. I am frustrated to the point of pulling my hair out.
Just to get some of the obvious things out of the way,
1) I tried running it in the workbook open process (failed)
2) I tried running it as a sub connected to a button (Failed)
3) Yes macros are enabled
4) Yes the vba environment access is enabled in macro settings.
I cant pay someone to help me with this so I am appealing to the community to PLEASE help me
Drake1986
08-13-2021, 12:31 AM
Im not sure if I am allowed to attach the workbook but here goes.
or here is the raw code:
Module1:
Option Explicit
Dim Msg_Box_Answer As Integer
Dim counter As Long
Public Const SheetPass As String = "Pass"
Dim Driveletter As String
Dim VerNum As String
Function Read_From_File(Path As String) As String
'PURPOSE: Send All Data From Text File To A String Variable
Dim Filepath As String
Dim TextFile As Integer
'File Path of Text File
Filepath = Path
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file
Open Filepath For Input As TextFile
'Store file content inside a variable
Read_From_File = Input(LOF(TextFile), TextFile)
'Close Text File
Close TextFile
End Function
Function Find_Drive_Letter(shareToFind As String) As String
Dim FindDriveLetter As String
Dim fs As Object
Dim dc As Object
Dim d As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.drivetype = 3 Then
If UCase(d.sharename) = UCase(shareToFind) Then
Find_Drive_Letter = d.Driveletter
Exit Function
End If
End If
Next
FindDriveLetter = ""
End Function
Sub Opening_Procedure()
'open in report mode
Sheets("Obj and Tar Background").Visible = xlSheetVeryHidden
Sheets("SHE Strategy").Visible = xlSheetVeryHidden
Sheets("Background Data").Visible = xlSheetVeryHidden
Sheets("Deviation Admin").Visible = xlSheetVeryHidden
Sheets("Incident Admin Historical").Visible = xlSheetVeryHidden
Sheets("LTI calculation").Visible = xlSheetVeryHidden
Sheets("Incident Stats").Visible = xlSheetVeryHidden
Sheets("Settings").Visible = xlSheetVeryHidden
Sheets("Historical Summary ").Visible = xlSheetVeryHidden
' see if the pc is connected to the drive
Driveletter = Module1.Find_Drive_Letter("\\babad12012\Training Reports")
' If the drive is connected, change the drive letter and network path to the specified folder for updates
If Driveletter <> "" Then
If VerNum <> Sheets("Site Information").Range("D7").Value Then
MsgBox ("There may be an update available. Please run an update from the settings tab")
End If
End If
' setup pages and formats
Setup_LTI_overview
Setup_SHE_Strategy
Setup_SHE_LTI_calculation
Setup_Obj_and_Tar_Background
Setup_SHE_Objectives_and_Targets
Setup_Deviation_Admin
Setup_Incident_Admin_Historical
Setup_Incident_Admin
Setup_Training
Setup_Front_page
Setup_Theme
Sheets("Site Information").Select
End Sub
Sub Run_update()
Dim UpdateLocation As String
Dim DisplayUpdates As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
' see if the pc is connected to the drive
Driveletter = Module1.Find_Drive_Letter("\\babad12012\Training Reports")
' If the drive is connected, change the drive letter and network path to the specified folder for updates
If Driveletter <> "" Then
'find the version number and then point the system to the correct latest update (Thus creating possible roleback option)
ChDrive Driveletter
VerNum = Read_From_File(Driveletter + ":\Month End Manager\DLL\Version.txt")
UpdateLocation = Driveletter + ":\Month End Manager\DLL\U861204" + VerNum + ".bas"
'if the program has updated, display those updates
If VerNum <> Sheets("Site Information").Range("D7").Value Then
' Try and do the update
On Error GoTo UpdateErrorHandler
' set the location for .bas update
UpdateLocation = Driveletter + ":\Month End Manager\Updates\Update " + VerNum + ".bas"
If FSO.FileExists(UpdateLocation) Then
' remove the current mod and replace it with the updated mod
DataSubMod.InsertVBComponent ThisWorkbook, UpdateLocation
'update the update log
Update_update_log_Reccord
'display the updates done
DisplayUpdates = Read_From_File(Driveletter + ":\Month End Manager\Updates\Update " + VerNum + ".txt")
MsgBox (DisplayUpdates)
Sheets("Site Information").Range("D7").Value = VerNum
Else
MsgBox ("The update required has been removed" & vbCrLf & "Please contact the system developer. The update was not done")
End If
End If
' cancel the update error handler
On Error GoTo 0
Else
'If the drive is not connected, display message
MsgBox ("Automatic updates disabled." & vbCrLf & "This could be because you are using the program in report mode, or you are not connected to the site drive" & vbCrLf & "THIS IS NORMAL FOR REPORT MODE")
End If
Exit Sub
UpdateErrorHandler:
MsgBox ("A Faital error occured during the update process" & vbCrLf & "Please contact the program designer")
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------
DataSubMod
--------------------------------------------------------------------------------------------------------------------------------------------------
Function CheckSum() As String
CheckSum = #12/31/2025#
End Function
Sub InsertVBComponent(ByVal wb As Workbook, ByVal CompFileName As String)
ThisWorkbook.Activate
Set wb = ThisWorkbook
' Inserts the content of CompFileName as a new component in workbook
' CompFileName must be a valid VBA component suited for
' import (an exported VBA component)
Application.EnableEvents = False
'Checking whether CompFileName file exists
If Dir(CompFileName) <> "" Then
'Ignore Errors
On Error Resume Next
wb.VBProject.VBComponents("Module1").Name = "Previous"
'Inserts component from file
wb.VBProject.VBComponents.Import CompFileName
wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents("Previous")
End If
Set wb = Nothing
Application.EnableEvents = True
End Sub
Use an AddIn instead of this code.
Drake1986
08-13-2021, 01:52 AM
Sorry, I have no idea what an AddIn is.
Would that allow me to change the background code and so forth? I will also youtube to learn more about AddIns.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.