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
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
' 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
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
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")
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
Reply With Quote