I'm trying to set an Access Module as a variable so that I can call certain functions using the variable name and not the actual module name. this will save me a lot of time changing the name of the called module in my forms.
I tried adding a Public variable 'Mod_ActiveModule' as seen below:
Public Str_FormLevel_01 As String
Public Str_FormLevel_02 As String
Public Str_FormLevel_03 As String
Public frm_FormLevel_01 As Form
Public frm_FormLevel_02 As Form
Public frm_FormLevel_03 As Form
Public Mod_ActiveModule As Module
Shown below is the Sub that I thought would set 'Mod_ActiveModule' to the Module named "Mod_Batches_DP_Pack" - BUT IT ISN'T WORKING!!!!
Private Sub cmd_Options_Click()
On Error GoTo ErrorHandler
Str_FormLevel_01 = "frm_Batches_04_DP_Pack"
Str_FormLevel_02 = "frm_Batches_04_DP_Pack_Edit"
Str_FormLevel_03 = "frm_Batches_04_DP_Pack_Edit_Detail"
Set frm_FormLevel_01 = Form_frm_Batches_04_DP_Pack
Set frm_FormLevel_02 = Form_frm_Batches_04_DP_Pack_Edit
Set frm_FormLevel_03 = Form_frm_Batches_04_DP_Pack_Edit_Detail
Set Mod_ActiveModule = Mod_Batches_DP_Pack
Call ActiveModule.SetUpContextMenu_Level_01
CommandBars("MenuOptions").ShowPopup
ExitHandler:
Exit Sub
ErrorHandler:
Debug.Print "Error: " & Err.Number & ": " & Err.Description
Debug.Print "Error On: " & Form.Name & " - cmd_Options_Click"
Resume ExitHandler
End Sub
Any help here would be greatly appreciated
Related
So, I have this class where I call a few classes where data is checked. They give back an error class, named Failcase. Now I get an error when I first set the error to true.
The error states:
Invalid use of Property.
Private Sub btnImport_Click()
Dim fail As Failcase
Set fail.Success = True '<---- This is where the error occures
Set fail = ImportCheckSpec(Me.txtImportSpec)
If fail.Success Then
MsgBox "Error " + CStr(fail.Code) + ": " + fail.Message, vbCritical, "Error"
Exit Sub
End If
Set fail = ImportCheckDate(Me.txtDateTime)
If fail.Success Then
MsgBox "Error " + CStr(fail.Code) + ": " + fail.Message, vbCritical, "Error"
Exit Sub
Else
MsgBox "Success"
End If
End Sub
The Failcase class looks like this:
Option Compare Database
Option Explicit
Public Success As Boolean
Public Code As Integer
Public Message As String
I use:
Microsoft Access 2013
VBA
You are using OOP without creating a new object of class Failcase. Try this in the module:
Option Explicit
Public Sub TestMe()
Dim fail As New failcase
fail.Success = True
Debug.Print fail.Success
End Sub
In the class:
Option Explicit
Private m_bSuccess As Boolean
Public Property Get Success() As Boolean
Success = m_bSuccess
End Property
Public Property Let Success(ByVal bNewValue As Boolean)
m_bSuccess = bNewValue
End Property
Thus, you would achieve encapsulation. With it, you may set a bit more rules for accessing your property - https://www.google.com/search?q=encapsulation+oop&oq=encapsulation+oop&aqs=chrome..69i57j0l5.3599j0j7&sourceid=chrome&ie=UTF-8
The code above was an example of early binding. This is another one, example of late binding, doing the same:
Public Sub TestLateBinding()
Dim fail As Object
Set fail = New failcase
fail.Success = True
Debug.Print fail.Success
End Sub
Early and late binding have different pros and cons.
It works like this.
Dim fail As New Failcase
fail.Success = True
I want to be able to make PowerPoint speak, say something.
I tried this code to make PP speak:
Private Sub CommandButton1_Click()
Application.Speech.Speak "Hello World"
End Sub
But the code doesn't work, it doesn't exists. What can I do, which is the right code?
It says:
Compile Error Method or Data member not found.
Sorry for any error on my question.
The reason it's not working is that there's no Application.Speech property/method in the PPT object model. Somewhere or other I've seen code that invokes Excel to do the lifting but here's an answer from John Wilson of PPT Alchemy that seems more direct:
There is a page on our site about talking message boxes
http://www.pptalchemy.co.uk/PowerPoint_speech.html
It could be easily modified to speak the text in a shape in Slide Show mode.
Sub speak(oshp As Shape)
Dim strSpeak As String
Dim SAPIObj As Object
Set SAPIObj = CreateObject("SAPI.SPvoice")
SAPIObj.Rate = -2
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
strSpeak = oshp.TextFrame.TextRange.Text
End If
End If
SAPIObj.speak "<pitch middle='-15'>" & strSpeak
End Sub
If you don't need to pick up the text from a particular shape, a modification along these lines should do it:
Sub SayThisAloud(sText as String)
Dim SAPIObj As Object
Set SAPIObj = CreateObject("SAPI.SPvoice")
SAPIObj.Rate = -2
SAPIObj.speak "<pitch middle='-15'>" & sText
End Sub
REgarding the MSDN page, it'll take some editing/modification to convert it to something a bit more useful. For example, here's an example of how you can get a list of the voices available:
In the declarations section:
Private V As Object
Private T As Object
Then
Sub ListVoices()
On Error GoTo EH
Dim strVoice As String
Dim SAPIObj As Object
Set SAPIObj = CreateObject("SAPI.SPvoice")
'Get each token in the collection returned by GetVoices
For Each T In SAPIObj.GetVoices
strVoice = T.GetDescription 'The token's name
'List1.AddItem strVoice 'Add to listbox
Debug.Print strVoice
Next
Exit Sub
EH:
If Err.Number Then ShowErrMsg
End Sub
Private Sub ShowErrMsg()
' Declare identifiers:
Dim T As String
T = "Desc: " & Err.Description & vbNewLine
T = T & "Err #: " & Err.Number
MsgBox T, vbExclamation, "Run-Time Error"
End
End Sub
What I am trying to do is map my button (import button on my form) to import text files (the text file would actually be on a network drive). These text files are fixed columns. I am confused on how to merge a form and module to work together. How does the button on the form, call out this module for execution? Also, if there is a more efficient way to import these fixed text files, I would appreciate it.
I currently have the following VBA code setup for my form (will be used to Import text files into my Access database):
Private Sub cmdImport_Click()
On Error GoTo Click_Err
reportDate = Format(txtReportDate, "YYMMDD")
reportGenDate = Format(textReportDate, "YYYYMMDD")
rDate = txtReportDate
If Nz(txtReportDate, "") = "" Then
MsgBox "NOTICE! Please enter the Report Month you wish to Import."
Exit Sub
End If
DoCmd.Hourglass True
DoCmd.SetWarnings False
ImportAll
DoCmd.Hourglass False
DoCmd.SetWarnings True
MsgBox "Finished Importing!"
DoCmd.OpenQuery "query_Files_Loaded_CE", acViewNormal, acReadOnly
click_Exit:
DoCmd.Hourglass False
DoCmd.SetWarnings True
Exit Sub
Click_Err:
DoCmd.Hourglass False
MsgBox "Error Detected: " & Err.Number & " - " & Err.Description, vbCritical, "Error"
Resume click_Exit
End Sub
For my module (please excuse the notes):
Option Compare Database
Public reportDate As String
Public reportGenDate As String
Public rDate As Date
Public Function Import2010()
'Used to import a date range
Dim funcDate As Date '
funcDate = #2/1/2016#
reportDate = Format(funcDate, "YYMM")
rDate = funcDate
'Basically Do While is a loop so what your doing here as long as the value of the date does not EQUAL 3/1/2016
'excute the nexxt line of code other wise exit this loop
Do While funcDate <> #3/1/2016#
DoCmd.SetWarnings False
'ImportAll
ImportFile "H3561"
'Msg Box reportDate
funcDate = DateAdd("m", 1, funcDate)
reportDate = Format(funcDate, "YYMM")
rDate = funcDate
Loop
DoCmd.SetWarnings True
End Function
Public Function ImportAll() ' Import button on FrmIMport
'A recordset is a selection of records from a table or query.
'Dim is short for the word Dimension and it allows you to declare variable names and their type.
'When you read data from the database in VBA, the result will be in a recordset (with the exception of scalar data).
Dim rs As Recordset
Dim sql As String
'This code loops through the recordset of all contracts and import files, as in it looks for
'Specific value based off a specific condition.
sql = "SELECT DISTINCT Contract FROM Contract_CE"
Set rs = CurrentDb.OpenRecordset(sql)
rs.MoveLast 'This method is used to move to the last record in a Recordset object. It also makes the last record the current record.
rs.MoveFirst 'This method is used to move to the first record in a Recordset object. It also makes the first record the current record.
If rs.RecordCount > 0 Then
Do While rs.EOF = False
ImportFile rs!contract
rs.MoveNext 'This method is used to move to the next record in a Recordset object. It also makes the "next" record the current record.
Loop
End If
End Function
Public Function ImportFile(contract As String)
Dim filepath As String
Dim tempPath As String
Dim zipFile As String
'Set paths
filepath = "\\XXXXX\XXXXX\XXXXX\XXXXXXX"
'tempPath =
tempPath = "\\XXXXXX\XXXXX\XXXXX\XX"
'Find the file
zipFile = GetFile(filepath)
'check if file exists
If zipFile = "" Then
'DoCmd.Hourglass False
'MsgBox contract & " " & reportDate & " File could not be located."
'DoCmd.Hourglass True
LogFail (contract)
Exit Function
End If
'Clearing out existing Contract/ReportDate data from Table
DeleteContract (contract)
'Delete all files in temp folder
DeleteAllFiles (tempPath)
'UnzipFile txt to temp folder
UnZip filepath & zipFile, tempPath
'Get txt file namee
txtFile = Replace(zipFile, ".zip", ".txt")
DoEvents
Sleep 10000 'wait for file to unzip
'The TransferText method is used to import/export text between the current Access database or Access project and a text file located
'externally to your database. You can also use this command to link to data in a text file. Additionally, can import from, export to, and link to a table in an HTML file.
'Importing txt file
'Depcreated - Alec Johnson - 5/12/2016 - Created new import spec
'DoCMD.TransferText acImportFixed, "ImportSpec_COMPRPT", tempPath & txtfile, False
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False '<--does path go here?
'Update FileName
UpdateFileName (zipFile)
'Delete txt file from location
DeleteAllFiles (tempPath)
'Delete any Null records added to main table
DeleteNulls
'Log to table if successful
LogSuccess (contract)
End Function
Public Function DeleteAllFiles(path As String)
'Delete all files in this folder
On Error Resume Next
Kill path & "*.*"
End Function
Function UnZip(filename As String, destinationPath As String)
'FileSystemObject also called as FSO, provides an easy object based model to access computer’s file system.
'You simply have to create an instance of FileSystemObject in VBA and then you can generate files, read files, delete files,
'iterate though folders and do many other operations on your computer’s file system.
'Unzip file (s) to destination
Dim app As Object
Dim zipFile As Variant, unzipTo As Variant
zipFile = filename
unzipTo = destinationPath
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(unzipTo) Then
FSO.CreateFolder (unzipTo)
End If
'If you want to extract only file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.items("test.txt")
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(unzipTo).CopyHere oApp.Namespace(zipFile).Items
Set FSO = Nothing
End Function
Public Function GetFile(filepath As String) As String
Dim fileNamePart As String
Dim fCheck
fileNamePart = "COMPRPT_" + reportDate
fCheck = ""
fFound = ""
Set oFolder = CreateObject("scripting.filesystemobject").GetFolder(filepath)
For Each aFile In oFolder.Files
Set fCheck = aFile
If InStr(fCheck.Name, fileNamePart) Then
Set fFound = aFile
End If
Next
If fFound = "" Then
GetFile = ""
Else
GetFile = fFound.Name
End If
End Function
Public Function DeleteContract(contract As String)
Dim sql As String
sql = "Delete * FROM COMPRPT WHERE ContractNumber = '" & contract & "' AND ReportGenerationDate = '" & reportGenDate & "'"
DoCmd.RunSQL sql
End Function
Public Function LogSuccess(contract As String)
Dim sql As String
sql = "INSERT INTO FilesLoaded (Contract, ReportDate, Loaded) VALUES ('" & contract & "', #" & rDate & "#, -1)"
DoCmd.RunSQL sql
End Function
Public Function DeleteNulls()
Dim sql As String
sql = "DELETE * FROM COMPRPT WHERE ContractNumber Is Null"
DoCmd.RunSQL sql
End Function
Public Function lksjdlaskjd()
ImportFile "H0351", #4/1/2009#
End Function
Here is an example of a text file:
If I understand it correctly, your problem lies here:
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", filepath & txtFile, False '<--does path go here?
But you have unzipped to tempPath, so that should be
DoCmd.TransferText acImportFixed, "COMPRPT_2016", "COMPRPT_CE", tempPath & txtFile, False
Working with network files is generally slower than with local files, so I would make tempPath a local path.
Edit: Note that to make tempPath & txtFile work, tempPath must end with a \:
tempPath = "C:\XXXXXX\XXXXX\XXXXX\XX\"
Additional problems with your code:
1 - First and foremost, use Option Explicit, see this question for details.
You have multiple undeclared or misspelled variables, e.g. fFound, and oApp vs. app.
2 - This is an error just waiting to happen:
reportDate = Format(txtReportDate, "YYMMDD")
reportGenDate = Format(textReportDate, "YYYYMMDD")
Name the second textbox txtReportGenDate, not textReportDate.
3 - In ImportAll(), all this isn't needed, since you don't use the RecordCount:
rs.MoveLast
rs.MoveFirst
If rs.RecordCount > 0 Then
4 - This is wrong syntax:
DeleteContract (contract)
It works for a single argument, but will fail for subs with >1 parameters.
Use
DeleteContract contract
or
Call DeleteContract(contract)
or
retVal = DeleteContract(contract)
I am confused on how to merge a form and module to work together. How does the button on the form, call out this module for execution?
Objects and procedures can be considered public or private. For example: -
Private Sub Test
Msgbox "Hello World!"
End Sub
Is private, this means only its parent can call upon it. To elaborate on this, Lets create two modules Module1 and Module2 and place our private sub Test in Module1.
Also in Module1 we another private procedure: -
Private Sub Test2
Msgbox "Back at ya"
End Sub
Module1 is the parent of Test and Test2, as they have the same parent they can run each other: -
Private Sub Test
Msgbox "Hello World!"
Test2 'This will run the Test2 procedure
End Sub
Module2 can not run any of them because it has no view f them, its not involved.
Now if we change Test to be public (Public Sub Test), Module2 will be able to see it as it has been exposed.
In Module2 we have: -
Public Sub Test3
Module1.Test 'This will run as it is public
Module1.Test2 'This will fail as it is private
End Sub
There is also this way too call them from Module two: -
Public Sub Test3
Test 'This will run as it is public
Test2 'This will fail as it is private
End Sub
This is not explicit though and can cause error and confusion, you can have a procedure in Module2 that is also called Test, how would you know which test Test3 is running? To be safe you explicit write its location as Module1.Test.
I have a set of macros defined in my workbook, and I'd like to offer the user the option to log events related to those macros in a log file.
I initiate the log by creating the following in ThisWorkbook:
Public writeLog as Boolean
Public logWrite as Object
Public log as Object
Private Sub Worksheet_Open()
Dim prompt as Integer
prompt = MsgBox("Would you like to log events for this session?", vbYesNo, "Log Events?")
If prompt Then
writeLog = True
Set logWrite = CreateObject("Scripting.FileSystemObject")
Set log = logWrite.CreateTextFile("C:/TEST.txt", False)
Else
writeLog = False
End If
End Sub
I then created a procedure that I can use to write an argument to this object, which I've stored in its own module:
Public Sub PrintLog(obj as Object, argument as String)
If writeLog = True Then
obj.WriteLine argument
End If
End Sub
Unfortunately, this doesn't work, and I'm not sure why: even if I don't include obj as an argument to the function (since log and logWrite were created as global variables), I'm not able to Call WriteLog("String here.") or Call WriteLog(log, "String here.") without an error (Compile Error: Argument Not Optional.)
Is it possible to get such a Sub() to work, so that I can call it from anywhere in the workbook (after a button is pressed in a userform, for example) without having to define a new Scripting.FileSystemObject in every module?
I think that you can solve your problem by making some minor changes to your code. I tried the following setup:
logger module:
Option Explicit
Private log As Object
Public Sub initLog()
Dim prompt As VbMsgBoxResult
Dim fso As Object
prompt = MsgBox("Would you like to log events for this session?", vbYesNo, "Log Events?")
If prompt = vbYes Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set log = fso.CreateTextFile("C:/TEST.txt", False)
End If
End Sub
Public Sub PrintLog(argument As String)
If Not log Is Nothing Then
log.WriteLine argument
End If
End Sub
Public Sub yadda()
'test
PrintLog "yadda"
End Sub
ThisWorkbook:
Private Sub Workbook_Open()
initLog
End Sub
This is my no-frills drop in replacement for Debug.Print(), that logs to "Log.txt" at your Workbook path.
To install : Just search and replace "Debug.Print" with "Log", and optionally call LogClear() at the start of your program.
Public Function Log(ByRef a_stringLogThis As String)
' send to TTY
Debug.Print (a_stringLogThis)
' append (not write) to disk
Open ThisWorkbook.path & "\Log.txt" For Append As #1
Print #1, a_stringLogThis
Close #1
End Function
OPTIONAL : And here's a helper you COULD call at the beginning of your to clear out the previous logs.
Public Function LogClear()
Debug.Print ("Erasing the previous logs.")
Open ThisWorkbook.path & "\Log.txt" For Output As #1
Print #1, ""
Close #1
End Function
OPTIONAL : Finally, if can't live without date and time in your logging, use this Log statement instead:
Public Function Log(ByRef a_stringLogThis As String)
' prepare date
l_stringDateTimeNow = Now
l_stringToday = Format(l_stringDateTimeNow, "YYYY-MM-DD hh:mm:ss")
' concatenate date and what the user wants logged
l_stringLogStatement = l_stringToday & " " & a_stringLogThis
' send to TTY
Debug.Print (l_stringLogStatement)
' append (not write) to disk
Open ThisWorkbook.path & "\Log.txt" For Append As #1
Print #1, l_stringLogStatement
Close #1
End Function
I believe you're having issues as writeLog already exists as a boolean. Error should be popping up "Ambiguous name detected"
Try the following,
Public bLog as Boolean
Public logWrite as Object
Public log as Object
Private Sub Worksheet_Open()
Dim prompt as Integer
prompt = MsgBox("Would you like to log events for this session?", vbYesNo, "Log Events?")
If prompt Then
bLog = True
Set logWrite = CreateObject("Scripting.FileSystemObject")
Set log = logWrite.CreateTextFile("C:/TEST.txt", False)
Else
bLog = False
End If
End Sub
Public Sub WriteLog(Optional obj as Object, Optional argument as String)
If bLog = True Then
obj.WriteLine argument
End If
End Sub
Edit: made parameters optional in WriteLog (or PrintLog) for further testing
' Write to a log file using Separator and Array of variant Parameters
' Auto generate the file
' USE EndLog to close
'use:
' PrintLog vbtab, "one", 2, 3
' PrintLog vbtab, "Apple","Windows","Linux","Android","Commodore","Amiga","Spectrum"
' EndLog
' Generate a csv file:
' PrintLog ";", rst!ID, rst!Name
Private FileLog As Object
Private fso As Object
Const DEBUG_LOG_FILE = "C:\log.txt"
Public Sub PrintLog(ByVal Separator As String, ParamArray Arguments() As Variant)
Dim ele As Variant
Dim line As String
If FileLog Is Nothing Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileLog = fso.CreateTextFile(DEBUG_LOG_FILE, True, True)
End If
line = CStr(Now()) ' Print Timestamp
For Each ele In Arguments
If line > "" Then line = line & Separator
line = line & CStr(ele)
Next
If line > "" Then FileLog.WriteLine line
End Sub
Public Sub EndLog()
On Error Resume Next
FileLog.Close
Set FileLog = Nothing
Set fso = Nothing
On Error GoTo 0
End Sub
Is it possible to change the Startup Display Form using VBA? It is very easy to do using the Access Options page, but I am trying to do this from within VBA and nothing seems to work. I've searched all over looking for Database properties or settings that would allow for this.
Does anyone have any insight into this issue?
I don't know about directly changing the startup form property but what you could try is creating a form that can load your desired startup form. This way you can for instance store the form to be loaded in a config table and change it via VBA.
Downside is that effectively two forms are started and not one.
Have a look at the autoexec macro. It'll run code for you when your database is launched. Use this to load a form.
You can set a form to automatically open up in access VBA by setting the built-in database property StartUpForm to the name of the form.
To remove this form from startup you can simply delete that property.
Private Sub debug_properties()
ListProperties
SetProperty "StartupForm", 10, "Form_Name" 'UPDATE TO YOUR FORM NAME
' DeleteProperty "StartupForm"
' ListProperties
End Sub
Public Function SetProperty(ByVal propName As String, ByVal propType As Long, propValue As Variant)
''SetProperty will create a property if it doesn't exist
On Error GoTo SetProperty_Err
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = CurrentDb
Dim prps As DAO.Properties ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set prps = dbs.Properties
''attempt to set property
prps(propName) = propValue
SetProperty_Exit:
On Error Resume Next
On Error GoTo 0
Exit Function
SetProperty_Err:
Select Case Err.Number
Case 3270 ''The property was not found
''create property
Dim prp As DAO.Property
Set prp = dbs.CreateProperty(Name:=propName, _
Type:=propType, _
Value:=propValue)
''add new property to collection
dbs.Properties.Append prp
Case Else
MsgBox "SetProperty, Error " & Err.Number & ": " & Err.Description
End Select
Resume SetProperty_Exit
End Function
Private Function DeleteProperty(ByVal propName As String)
On Error GoTo DeleteProperty_Err
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = CurrentDb
dbs.Properties.Delete propName
DeleteProperty_Exit:
On Error Resume Next
On Error GoTo 0
Exit Function
DeleteProperty_Err:
Select Case Err.Number
Case 3265 ''The property was not found
MsgBox "Property '" & propName & "' does not exist."
Case Else
MsgBox "DeleteProperty, Error " & Err.Number & ": " & Err.Description
End Select
Resume DeleteProperty_Exit
End Function
Private Sub ListProperties()
''Lists DB properties created in code (as well as built-in properties)
Dim dbs As DAO.Database ''Reference: Microsoft Office 16.0 Access database engine Object Library 'ACEDAO.DLL 'Access.References.AddFromGuid "{4AC9E1DA-5BAD-4AC7-86E3-24F4CDCECA28}", 0, 0
Set dbs = Application.CurrentDb
Debug.Print vbCrLf & Format(Now, "hh:mm:ss") & " ======="
Debug.Print """" & Mid(CurrentDb.Name, _
InStrRev(CurrentDb.Name, "\") + 1, _
InStr(CurrentDb.Name, ".accdb") - InStrRev(CurrentDb.Name, "\") - 1) & _
""" Properties: "
On Error Resume Next 'skips the 'connection' property which has no 'value' for some reason
Dim prp As DAO.Property
For Each prp In dbs.Properties
Debug.Print prp.Name & ": " & prp.Value
Next prp
On Error GoTo 0
End Sub