Open Access 2003 .mde file through Excel VBA - vba

I am trying to open an Access 2003 .mde file using Excel VBA.
So far I have tried:
Shell ("cscript "C:\User\Folder\Access Database.mde""), vbHide
Now this works perfect to open a .vbs file and the code runs to open the .mde file but does not actually open the database.
I also tried the following:
strdb = "C:\User\Folder\Access Database.mde"
Set AccessApp = CreateObject("Access.Application")
AccessApp.Visible = True
AccessApp.OpenCurrentDatabase.strdb
AccessApp.DoCmd.OpenForm "frmsysteminformation"
Set AccessApp= Nothing
I found this online but it gives me a debug error highlight the line:
Set AccessApp = CreateObject("Access.Application")
Thanks
Edit My company seems to have disabled some of the features as
CreateObject("Outlook.Application")
also doesn't work. Is there a way to run this through cscript?

Just in case anyone stumbles across this same issue I managed to work it out:
Dim sAcc
Dim sFrontEnd
Dim sSec
Dim sUser
Dim objShellDb
Dim sComTxt
'Script Configuration Variable
'*******************************************************************************
'Specify the Fullpath and filename of the msaccess executable
sAcc = "C:\Program Files\Microsoft Office\Office11\MSACCESS.EXE"
'Specify the Fullpath and filename of the database to launch
sFrontEnd = "C:\users\file location\Database to open.mde"
Set objShellDb = CreateObject("WScript.Shell")
'Build the command to launch the database
sComTxt = Chr(34) & sAcc & Chr(34) & " " & Chr(34) & sFrontEnd & Chr(34)
objShellDb.Run sComTxt 'Launch the database
End Sub

Related

How do I implement QR code generator into a different access file?

I came accross this this post: https://www.access-programmers.co.uk/forums/threads/qrcode-image-generator.299675/
I have tried to copy and edit the VBA code and more into my own access file but it comes with error.
Edited:
To generate an offline QR code in Access, I keep getting this error.
It happens on load and unload form.
I am trying to implement the QR code generator into my own access program.
This is the onLoad code: it's the exact same and all paths are still the same.
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
Dim fld As DAO.Field2
Dim strExcel As String
strExcel = CurrentProject.Path & "\QRCode.xlsm"
If Dir(strExcel) = "" Then
Set rsParent = CurrentDb.OpenRecordset("tblQRSheet", dbOpenDynaset)
rsParent.MoveFirst
Set rsChild = rsParent.Fields("attachment").Value
Set fld = rsChild.Fields("FileData")
fld.SaveToFile strExcel
Set fld = Nothing
rsChild.Close
rsParent.Close
Set rsChild = Nothing
Set rsParent = Nothing
End If
If Dir(CurrentProject.Path & "\QRCodeImages", vbDirectory) = "" Then
MkDir CurrentProject.Path & "\QRCodeImages"
End If
Set gxlApp = CreateObject("Excel.Application")
Set gxlWB = gxlApp.Workbooks.Open(CurrentProject.Path & "\QRCode.xlsm", False, False)
If anyone has any ideas or can help me make this QR code generator work in my own file that would be great. I think that it has to do with the Form's Record Source.
That error implies that you are using types (classes) that are not defined. You have to add the references for it to work. Probably the DAO reference is missing in your project. Go to Tools->References and select "Microsoft DAO 3.6 Object Library". Also the "Microsoft Excel Object Library" might be needed, even if the sample code uses an Object to create the Excel application.
In case this works but you still cannot generate QR codes, consider using an external executable that does just that, and call it using something like:
Dim strCmd As String : strCmd = """" & CurrentDBDir() & "\qrcode.exe"" -o " & """" & myFile & """" & " -s 10 -l H " & """" & strCode & """"
ShellWait strCmd
Where ShellWait is the utility created by Terry Kreft

VBA Access Write to PS1 file

I am trying to use Access 2016 as a front end for a database that when a user clicks a button it generates a Powershell script and runs it.
I am currently using this:
Dim Script As String
Script = ("test" & vbCrLf & "2nd line?")
Set f = fileSysObject.OpenTextFile("C:\Users\%Username%\Documents\Access.ps1", True, True)
f.Write Script
f.Close
Then to run the script I am using:
Dim run
run = Shell("powershell ""C:\Users\%Username%\Documents\Powershell\Access.ps1""", 1)
I realise that this is probably a really bad way of doing this! So any help is greatly appreciated!
Thanks!
EDIT:
Sorry there is no question!
The problem is that it highlights an error at 'f.write Script'
Compile Error: Method or data member not found.
The format %VAR% doesn't work in VBA, you need to Environ("VAR")
That said username doesn't return a value with that method, but you can use VBA.Environ("Username") in this case:
Dim strScript, strUserName, strFile As String
Dim objFSO, objFile as Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScript = ("test" & vbCrLf & "2nd line?")
strUserName = VBA.Environ("Username")
strFile = "C:\Users\" & strUserName & "\Documents\Access.ps1"
Set objFile = objFSO.CreateTextFile(strFile)
objFile.WriteLine strScript
objFile.Close
Set objFSO = Nothing
Set objFile = Nothing

Open the most recent folder in a directory

I'm trying to create a script that will open the latest folder in a directory.
The name of the folder will be different each month (01-Jan, 02-Feb e.t.c). The below seems to find the latest folder, but I get error File not found when I add in Shell "explorer.exe" & "" & strFullFldrPath, vbNormalFocus to open the folder.
This is what I have so far.
Sub GetLatestFolder()
Dim fso As FileSystemObject
Dim fldrRoot As Folder
Dim SubFld As Folder
Dim strFolderName As String
Dim strFullFldrPath As String
Set fso = New FileSystemObject
Set fldrRoot = fso.GetFolder("\\Hbeu.adroot.hsbc\dfsroot\GB002\RRU\DTCC EU Reports\ETD\")
For Each SubFld In fldrRoot.SubFolders
strFolderName = SubFld.Name
strFullFldrPath = fldrRoot & "\" & SubFld.Name
Shell "explorer.exe" & "" & strFullFldrPath, vbNormalFocus
Exit For
Next SubFld
End Sub
You try to run "explorer.exeC:\WHATEVER" i.e. your missing a space between the executable and its argument.
Quotes are a good idea to accommodate paths with spaces.
Shell "explorer.exe" & " """ & strFullFldrPath & """, vbNormalFocus
What you have does not guarantee the latest folder is always first, you should apply some logic based on the name or load all directories and sort.

Can't delete VBScript file after running it

I'm simulating multi-threading with VBA, the code creates multiple vbs files and runs them. But i am not able to delete them after they are completed, it says "can not find script file" Here is my code:
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
wshShell.Run """" & sFileName & """"
Kill sFileName
Set wshShell = Nothing
Any idea? Thanks
In our original code, as it's in asynchronous mode, Shell has not read the script file before you removing it.
Now I suggest a self-destruction mode.
As comments, we run .vbs again in an asynchronous mode, but the script file will be removed at the end of the vbscript, ie, inside the script itself. The deletion instructions are appended at the end of the VBScript to be created:
Sub sof20351356RunVbScript()
Dim intFileNum As Integer
Dim agentNr As Long
Dim sFileName As String, s As String
Dim wshShell
agentNr = 5
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
'
' In the file, we do our job normally,
' at the end, we kill the vbscript inside the script itself:
'
s = "MyVar = 1" & vbCrLf _
& "'... do foo bar" & vbCrLf
'
' now add the Killing order:
s = s _
& "Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf _
& "fso.DeleteFile """ & sFileName & """" & vbCrLf
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
'
' in synchronous mode:
'wshShell.Run """" & sFileName & """", 0, True
'
' in asynchronous mode:
wshShell.Run """" & sFileName & """", 0, False
'Kill sFileName
Set wshShell = Nothing
End Sub
Ref: http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx
As I tested so confirmed, before a script begins to run, it's read at 100% in memory by the Shell (Windows Script Interpreter), so the file itself has no more any importance when it starts executing. As a consequence, you can even add the destruction instruction at the beginning of the VBscript, before your true job.
But cmd.exe .bat file cannot be handled as this.
You're trying to delete a script file that is currently running. That's probably what is causing your problem.
How about using the wshShell.Exec method instead of Run? That way you can keep track of whether the VBScript is done running or not, and delay deleting the VBS file until it is done.
Proof-of-concept, not tested:
Dim oExec
Set oExec = wshShell.Exec("sFileName")
'Can launch more processes here...
'Now check if oExec process is done
Do While oExec.Status = 0
'oExec process not done yet...
WScript.Sleep 100
Loop
'It's done. Delete the file.
Kill sFileName
This is of course a simplistic example with only one process. You could launch more of them and store their handles (like oExec) in an array/collection/dictionary. Then periodically check all the handles in succession until they are all done running.

VBA copy self to other location

I have an Excel-Macro in VBA in which I want to copy the file from where the macro is executed into another location.
I tried it like this
Call FileCopy(currentDir & "\" & Filename, _
otherDir & "\" & Filename)
But I get an Access restricted Exception, although I have full access to all of the directories involved. Is it because I'm trying to "copy myself"? Is this possible? If not, could I build a workaround?
Try using
ThisWorkbook.SaveCopyAs otherDir & "Test1"
or
ThisWorkbook.SaveAs otherDir & "Test2"
ThisWorkbook refers to the workbook which contains the macro you are running...
Update : This should work for you to create a folder...
Make sure you add "Microsoft Scripting Runtime" under Tools -> references.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CreateFolder ("C:\test\test2")
ThisWorkbook.SaveCopyAs "c:\test\test2\ttt.xlsm"
Using FileCopy didnt work for me either but using CopyFile from FileSystemObject seems to work.
First you will need to add a Reference (Menu: Tools->References) to the Microsoft Scripting Runtime and then use the FileSystemObject
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CopyFile currentDir & "\" & Filename, otherDir & "\" & Filename, True
''the last parameter decides weather or not you want to overwrite existing files
Set fso = Nothing
Alternative: Save the document at the new destination and then save it back.
ThisWorkbook.SaveAs otherDir & "\" & Filename
ThisWorkbook.SaveAs currentDir & "\" & Filename