I am in need of a little help, I'm trying to exit sub, if a test.dll is detected (test.dll is just an example), and if the dll does not exist, just continue to do the other things in the code. I'm trying to do it like this, however even when the dll exists, the sub doesn't exist. Can you tell me where I am wrong? Any advice? I am leaving an example below.
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Sub main()
If GetModuleHandle("test.dll") = 1 Then
Exit Sub
Else
Do other things
End if
End sub
According to: [MS.Docs]: GetModuleHandleA function (libloaderapi.h) (emphasis is mine):
Retrieves a module handle for the specified module. The module must have been loaded by the calling process.
So:
GetModuleHandle is not the right way, as the .dll should already be loaded into the process for it to succeed (and its existence on disk would be irrelevant)
Even if it was the right way, the condition (= 1) is incorrect. Function returns (positive) handle values (the chance for such a value to be 1 is extremely slim), or NULL (0) if the .dll wasn't loaded
There are number of variants on [VBForums]: Classic VB - How can I check if a file exists? for example, taking the 1st (and simplest) one:
If Dir("test.dll") <> "" Then
Exit sub
Beware, the .dll path is important!!!
Traditionally file existence check is done by querying the file system for file's attributes.
Option Explicit
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Sub Form_Load()
If FileExists("test.dll") Then
MsgBox "DLL exists", vbExclamation
Else
'--- do other things
End If
End Sub
Public Function FileExists(sFile As String) As Boolean
If GetFileAttributes(sFile) = -1 Then ' INVALID_FILE_ATTRIBUTES
FileExists = (Err.LastDllError = 32) ' ERROR_SHARING_VIOLATION
Else
FileExists = True
End If
End Function
Accessing the attributes is (used to be) optimized in various network providers so this performed very well on network shares.
Using Dir to check for file existence might mess up with your current directory enumeration process. Generally Dir function in VB6 runtime is a very bad example of using global state for local operation -- never a good design pattern.
Related
I have some complex code which takes some user inputs (names of shapes to copy) then copies said shapes from one sheet to another multiple times. The items are grouped shapes drawn in Excel and all named correctly and uniquely.
I receive copy and paste errors intermittently "Method 'Paste' of object _Worksheet' failed" and "Method 'copy' Of Object '_worksheet' Failed. Through researching the problem we understand that it is fairly common and has something to do with programmes which conflict with Excel when they are accessing the clipboard.
So far, my colleague and I have deduced that 2 programmes in particular interfere the most with the copy/paste operations - Adobe Reader and Autodesk Powershape. (Autodesk and Adobe both have Reference Libraries available within VBA, not sure if this is a coincidence?)
The problem used to occur very frequently whilst we had the programmes open, so we wrote the following macros/functions to try and stablise the code:-
Public Sub CopyShape(ItemName, CopyDestination)
Call ClearClipboard Sheets(CopyDestination).Shapes(ItemName).Copy
Do Until IsClipboardEmpty = False DoEvents Loop
End Sub
Where "ClearClipboard" is:-
Public Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
and the function IsClipboardEmpty is:-
Function IsClipboardEmpty() As Boolean
IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function
with the following public declarations:-
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function CountClipboardFormats Lib "user32" () As Long
This code works quite a lot of the time (far better than trying to use "DoEvents" after the copy operation which just failed miserably) as it forces the code to check if the copied item is in the clipboard before trying to paste it, but it doesn't always work - something in the background still messes up the code.
Is there any way of either:-
locking and unlocking the clipboard using VBA or APIs?
using a completely different method of copying and pasting the shapes?
Any and all solutions welcome and of course happy to answers any questions.
Thanks
I have followed the tutorial on the following page to create a c++ DLL and I have put it in the System32 folder: http://msdn.microsoft.com/en-us/library/ms235636%28v=vs.80%29.aspx. I am able to run the .exe from anywhere on the PC. Now I want to be able to call Add from a VB.NET application, so I have added the following code:
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
Dim Test As Integer
Test = Add(1, 1)
MsgBox(Test)
Catch ex As Exception
End Try
End Sub
<DllImport("MathFuncsDll.dll", EntryPoint:="Add", SetLastError:=True, CharSet:=CharSet.Ansi)> _
Private Shared Function Add(ByVal a As Double, ByVal B As Double) As Double
End Function
End Class
I get the following error: Unable to find an entry point named 'Add' in DLL 'MathFuncsDll.dll. I believe this is because of the namespace. I have researched this and some web pages say namespaces are not allowed with Platform Invoke and some web pages say they are allowed. What is the problem?
The entry point is not named "Add". From the Visual Studio Command Prompt, run dumpbin /exports MathFuncsDll.dll to see the exported names. To get this declaration:
<DllImport("MathFuncsDll.dll", EntryPoint:="?Add#MyMathFuncs#MathFuncs##SANNN#Z", _
CallingConvention:=CallingConvention.Cdecl)> _
Private Shared Function Add(ByVal a As Double, ByVal B As Double) As Double
End Function
The strange looking name is produced by the C++ compiler, a feature called "name decoration". It supports function overloading. You can put extern "C" in front of the function declaration to suppress it. It is actually better if you don't. Also note that SetLastError wasn't correct, the code doesn't actually call SetLastError() to report errors. And CharSet wasn't appropriate, these functions don't take strings.
You'll also need to do something about the Divide function, throwing a C++ exception won't come to a good end in an interop scenario, only C++ code can catch the exception.
Namespaces are not allowed. PInvoke works like plain C client. Don't forget also to declare MathFuncsDll as extern "C" to prevent C++ name mangling. Use Dependency Walker or dumpbin to see list of functions exported from MathFuncsDll.
How can I check through my application if computer is connected with internet or not (at the moment)
I need a message if net is connected.
Thanks a lot
Furqan
ping.
Dim response As Boolean = False
response = My.Computer.Network.ping(google.com)
True, you have access, false, you don't, or the world is ending because google is offline.
I would try that.
It's from VB 6, but I think you can easily convert it.
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef
dwflags As Long, ByVal dwReserved As Long) As Long
Public Function IsOnline() As Boolean
Dim LFlags As Long
IsOnline = InternetGetConnectedState(LFlags, 0&)
End Function
http://bytes.com/topic/visual-basic/answers/14551-detecting-internet-connection
Internet connectivity should be handled similar to file availability.
With files, you should typically not use File.Exists() to first see if you can open a file because the results might change on you between when you perform the check and when you act on the results, let alone the difference between mere existence and read permissions. You have to handle the exceptions anyway, and so that's really a better place to concentrate your efforts.
The same is true for internet access. The best option is generally to just go and do it, and concentrate your development time on your exception handler.
Use this code :
If My.Computer.Network.IsAvailable Then
MsgBox("Computer is connected.")
Else
MsgBox("Computer is not connected.")
End If
Refer to this link.
Is there any option to close the currently opened MsgBox using any code in VBA access form application?
Check out Randy Birch's response on this thread in microsoft.public.vb.general.discussion
He recommends creating a function in a .bas file called MsgBox. Doing so will cause VB to call your function rather than the built in one.
You'd then create your own MsgBox form and build in a timer to close your form after a set period of time. He provides links showing how to do this.
He also discusses a way to explicitly call the built in MsgBox function in case you need to do this.
Note: I've never done this but I've found that Randy Birch is a knowledgeable resource.
MsgBoxes are not intended to be programmatically closed, that's why it's difficult to do so. If you find yourself in a design where you must force close a MsgBox, you should probably re-evaluate your design.
I may be wrong but MsgBox is a blocking call creating a modal form so I don't think there is an easy way such as an option to do that. Do you have a specific use case for this ?
As MarkJ points out, could this could be a dialog generated by Access (rather than a VBA.MsgBox called in your own code)?
For example, when using table's 'dataview' in the Access UI to add a row you get a message, "You are about to append 1 record..." (or similar). Is this the kind of message you mean? If so, there are indeed ways to suppress them...
I used to have an easy answer to this: use the Windows Scripting Shell object, which has a 'Popup' function - a Message Box, just like the VBA MsgBox() function, with a 'SecondsToWait' parameter that provides exactly the timeout you wanted.
With CreateObject("Scripting.WsShell")
.Popup "Watch me disappear in 5 seconds", 5, Application.Name & ": test", vbInformation + vbOkCancel
End With
If you include a 'Cancel' button, it might still work: the available parameters are vbOkCancel, vbYesNoCancel, and vbRetryCancel.
If you're trying to close a dialog box you didn't initiate with your own msgBox() function call, that's unhelpful: and, as I've hinted above, the 'SecondsToWait' parameter doesn't really work these days - someone in Redmond really does't like the idea of one thread closing another thread's helpful warnings and important interruptions to the user's workflow.
However, you can launch a delayed Message Box 'Close' command using the API Timer() function - not quite 'close the currently opened MsgBox', as this requires advance warning that you intended to open it - but it's the closest thing I have, it fits into a self-contained VBA module, and I posted the code in an answer to a very similar StackOverflow question to yours.
I should warn you that the answer in question is using a sledgehammer to crack a nut, with a side order of lengthy explanation.
Rather than writing an alternative to the Access MsgBox from scratch, you might consider using (or at least studying) Arvin Meyer's Custom MessageBox Creator (downloadable on this page).
Message Boxes are meant to depict some information to the user. Hence programmatically closing is not a good design, unless you are not automating some process.
You can use sendkeys or win APIs.
I have had a similar problem; theoretically you can use the "SendKeys" function (see http://msdn.microsoft.com/en-us/library/8c6yea83%28VS.85%29.aspx). However, the MsgBox blocks the running so you cannot use the command. If you know when it going to pop up, you may run (from the script) external whshell that wait some time and then use the SendKeys. But if you know how to do that, tell me (here). Other similar possibility is to open different thread/process for it that will not be block, but I don't know if it is possible in VBA.
An easy to use Win32 based answer to actually be useful calling it. Using the below code you can easily do a timer-based PopUpBox. I like 1/2 second timer control so 2 = 1 second. Found this answer looking for the answer to this thread. Above answers don't seem to work. I want to use this when I want to show a quick message or quick answer default is normally right can be used for more.
Function Code usually in a Module:
Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageID As Long, _
ByVal lngMilliseconds As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Function PopUpBox(Optional stMessage As String _
= "Yes or No? leaving this window for 1 min is the same as clicking Yes.", _
Optional stTitle As String = "PopUp Window", _
Optional HalfSecTimer As Long = 120, Optional lgVBmsgType As Long = vbYesNo) As Long
Dim RetVal As Long
HalfSecTimer = HalfSecTimer * 500
RetVal = MessageBoxTimeout(FindWindow(vbNullString, Title), stMessage, stTitle, lgVBmsgType, _
0, HalfSecTimer)
PopUpBox = RetVal
End Function
Call Function Code
Examples: Actual code from my database
PopUpBox "Re-Linking and Closing dB", "Closing dB", 3, vbOKOnly
intAnswer = PopUpBox("Software Lock Down Active?", "Security", 10, vbYesNo)
I know this is an old post, put it seems there is a new a easy way to do this:
Sub MessageBoxTimer()
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 10
Select Case InfoBox.Popup("Click OK (this window closes automatically after 10 seconds).", _
AckTime, "This is your Message Box", 0)
Case 1, -1
Exit Sub
End Select
End Sub
Sample code provided by: Tom Urtis
https://learn.microsoft.com/en-us/office/vba/excel/concepts/controls-dialogboxes-forms/automatically-dismiss-a-message-box
For a very long time, when I have an error handler I make it report what Project, Module, and Procedure the error was thrown in. I have always accomplished this by simply storing their name via constants. I know that in a Class you get the name programmatically with TypeName(Me), but obviously that only gets me one out of three pieces of information and only when I'm not in a "Standard" module.
I don't have a really huge problem with using constants, it's just that people don't always keep them up to date, or worse they copy and paste and then you have the wrong name being reported, etc. So what I would like to do is figure out a way to get rid of the Constants shown in the example, without losing the information.
Option Compare Binary
Option Explicit
Option Base 0
Option Private Module
Private Const m_strModuleName_c As String = "MyModule"
Private Sub Example()
Const strProcedureName_c As String = "Example"
On Error GoTo Err_Hnd
Exit_Proc:
On Error Resume Next
Exit Sub
Err_Hnd:
ErrorHandler.FormattedErrorMessage strProcedureName_c, m_strModuleName_c, _
Err.Description, Err.Source, Err.Number, Erl
Resume Exit_Proc
End Sub
Does anyone know ways to for the code to tell where it is? If you can conclusively show it can't be done, that's an answer too:)
Edit:I am also aware that the project name is in Err.Source. I was hoping to be able to get it without an exception for other purposes. If you know great, if not we can define that as outside the scope of the question.
I am also aware of how to get the error line, but that information is of course only somewhat helpful without knowing Module.Procedure.
For the project name, the only way I can think of doing this is by deliberately throwing an error somewhere in Sub Main(), and in the error handling code, save the resulting Err.Source into an global variable g_sProjectName. Otherwise, I seem to remember that there was a free 3rd party DLL called TLBINF32.DLL which did COM reflection - but that seems way over the top for what you want to do, and in any case there is probably a difference between public and private classes. And finally, you could use a binary editor to search for the project name string in your EXE, and then try to read the string from the position. Whilst it is frustrating that the names of every project and code module is embedded in the EXE, there seems to be no predictable way of doing this, so it is NOT recommended.
There are several questions here.
You can get the Project Name by calling App.Name
You cannot get the name of the method you are in. I recommend using the automated procedure templates from MZ Tools, which will automatically put in all the constants you need and your headache will be over.
The last piece is possibly having to know the name of the EXE (or lib) that invoked your ActiveX DLL. To figure this out, try the following:
'API Declarations'
Private Declare Function GetModuleFileName Lib _
"kernel32" Alias "GetModuleFileNameA" (ByVal _
hModule As Long, ByVal lpFileName As String, _
ByVal nSize As Long) As Long
Private Function WhosYourDaddy() As String
Dim AppPath As String
Const MAX_PATH = 260
On Error Resume Next
'allocate space for the string'
AppPath = Space$(MAX_PATH)
If GetModuleFileName(0, AppPath, Len(AppPath)) Then
'Remove NULLs from the result'
AppPath = Left$(AppPath, InStr(AppPath, vbNullChar) - 1)
WhosYourDaddy = AppPath
Else
WhosYourDaddy = "Not Found"
End If
End Function
Unfortunately, you'll need to have individual On Error GoTo X statements for individual modules and procedures. The project is always stored in Err.Source. The VBA error handling isn't all that great in this area -- after all, how much good does the project name as the source of the error, as opposed to procedure/module, do you.
If you manually or programatically number your lines (like old-school BASIC), you can use ERL to list the line number the error occurred on. Be warned, though, that an error that occurs on a line without a number will make ERL throw its own error, instead of returning a zero. More information can be found at this blog post.
If you're using Access 2007 (not sure about other Office apps/versions), try this code snippet dug out of the help documentation:
Sub PrintOpenModuleNames()
Dim i As Integer
Dim modOpenModules As Modules
Set modOpenModules = Application.Modules
For i = 0 To modOpenModules.Count - 1
Debug.Print modOpenModules(i).Name
Next
End Sub
And Microsoft includes these remarks:
All open modules are included in the
Modules collection, whether they are
uncompiled, are compiled, are in
break mode, or contain the code
that's running.
To determine whether an individual
Module object represents a standard
module or a class module, check the
Module object's Type property.
The Modules collection belongs to the
Microsoft Access Application object.
Individual Module objects in the
Modules collection are indexed
beginning with zero.
So far, I haven't been able to find anything on referencing the current Project or Procedure. but this should point you in the right direction.
I suggest you take a look at CodeSMART for VB6, This VB6 addin has a customizable Error Handling Schemes Manager, with macros that will insert strings for module name, method name, etc., into your error handling code with a single context menu selection.
Has some other very nice features as well - a Find In Files search that's superior to anything I'd seen till ReSharper, a Tab Order designer, and much more.
At my previous employer, we used this tool for many years, starting with the 2005 version. Once you get used to it,it's really hard to do without it.