PDA

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

snb
08-13-2021, 12:11 AM
Just show 'it'.

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

snb
08-13-2021, 01:33 AM
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.