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
Related
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
I copied this code from a differen website to try and help me import multiple text files at once. I changed filepaths, text specs, and the table to what I need. Now every time I try to run this is locks up and doesn't respond.
Is there an issue with having too many text files or too much data? How come its causing my program to lock up?
Public Sub WorkedAlertsImport()
On Error GoTo bImportFiles_Click_Err
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String
strFolderPath = "C:\Import TXT files\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files
For Each objF1 In objFiles
If Right(objF1.Name, 3) = "txt" Then
DoCmd.TransferText acImportDelim, "TextImportSpecs", "tblImportedFiles", strFolderPath & objF1.Name, False
Name strFolderPath & objF1.Name As "C:\Import TXT files\" & objF1.Name 'Move the files to the archive folder
End If
Next
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing
bImportFiles_Click_Exit:
Exit Sub
bImportFiles_Click_Err:
MsgBox Err.Number & " " & Err.Description
Resume bImportFiles_Click_Exit
End Sub
After a cursory review of your code, I see no reason why it would cause MS Access to lock up, which would typically be caused by code executing a loop which never met a terminating condition (however, a For Each loop is iterating over a fixed set of data and will therefore always terminate).
I would note that the following line is redundant:
Name strFolderPath & objF1.Name As "C:\Import TXT files\" & objF1.Name
Since earlier in the code you define strFolderPath as:
strFolderPath = "C:\Import TXT files\"
Hence, you are renaming the file to itself.
The code is also naïvely testing the last three characters of the filename, which may not necessarily yield an extension if you were to encounter a file without an extension.
The code could be written without using the FSO and without the if statement altogether, as VBA offers the Dir function as standard to iterate over files of a particular type in a directory, e.g.:
Sub test()
Dim strDir As String: strDir = "C:\Import TXT files"
Dim strTxt As String: strTxt = Dir(strDir & "\*.txt")
Do Until strTxt = vbNullString
DoCmd.TransferText acImportDelim, "TextImportSpecs", "tblImportedFiles", strDir & "\" & strTxt, False
strTxt = Dir
Loop
End Sub
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
I've a VBA script as below.
Sub AutoOpen()
ActiveDocument.Variables("LastOpen").Value = Now()
End Sub
Sub AutoClose()
Dim objFSO, objFolder, objTextFile, objFile
Dim strDirectory, strFile, strText
strDirectory = "d:\work"
strFile = "\work.csv"
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
Debug.Print "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
Debug.Print "Just created " & strDirectory & strFile
End If
Set objFile = Nothing
Set objFolder = Nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
'Build the string to write
strText = """" & ActiveDocument.FullName & """" & "," & ActiveDocument.Variables("LastOpen").Value & "," & Now()
' Writes strText every time you run this VBScript
objTextFile.WriteLine (strText)
objTextFile.Close
End Sub
here the macro is running fine, but the problem is when i open and close my word document, though there are no changes done, it asks me if i would like to save the changes like below.
please let me know how can i avoid this save dialogue box, if there are no changes made in document.
here if i open a blank document and close it, even then this is getting triggered.
As mentioned in comments, the creation of the variable in AutoOpen is causing this behavior.
Include a Save statement in AutoOpen:
Sub AutoOpen()
ActiveDocument.Variables("LastOpen").Value = Now()
ThisDocument.Save
End Sub
to avoid the Save prompt.
The following is the usual log function I utilize in alot of my vbscripts which I modify accordingly. I feel it writes too slow. I got 3 questions:
Any ideaas on how to optimize this so it writes faster?
Would it be faster to store all text in a string first then run the function OutputToLog or would it be faster to execute OutputToLog each time I needed to insert a string into the text file?
If drive space wasn't a factor, is it possible to run out of memory while writing to a text file during execution...causing the script to execute slower and slower?
Here is my vbscript function
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\log-"& StampNow & ".bat"
'strText = "test"
strText = strToAdd
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
thanks in advance
I think you'd want to both create your FSO objects and open your log file outside the the OutputToLog function. It may not save much time, but why create objects, open and close files with every write?
Otherwise if you want to keep the functions as is, doing just one write should be quicker.
If you're doing a lot of small writes then refactoring the checks for FolderExists and FileExists out will help a bit. Maybe try to write to the file, trapping any errors, and check for FolderExists and FileExists in the error handler and create them if necessary?
It'll be quicker to output one large string rather than several small ones, but you have to balance that against the possibility of losing log entries if your program crashes.
Memory shouldn't be a problem unless you're writing a humungous string to the file, and probably not even then.
Because you're appending to the file, the longer the log file gets the longer the write will take, because (AFAIK) the entire file has to be rewritten each time. That's another reason for writing longer strings less frequently.
Could you use Windows' Event Log instead?
Do all your folder/file checking and creating once in a prep function, then you can just append to the log file safe in the knowledge that it'll be there? Also, you should be able to just create the fso object once.
Something like the following (untested code)
Dim loggerFSO
Function PrepLog
dim objFolder
' Create the File System Object
if loggerFSO is nothing then Set loggerFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If loggerFSO.FolderExists(strDirectory) Then
Set objFolder = loggerFSO.GetFolder(strDirectory)
Else
Set objFolder = loggerFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If loggerFSO.FileExists(strDirectory & strFile) Then
' do nothing
Else
loggerFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
End function
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objTextFile
strDirectory = "c:\log"
strFile = "\log-"& StampNow & ".bat"
'strText = "test"
strText = strToAdd
' Create the File System Object
if loggerFSO is nothing then Set loggerFSO = CreateObject("Scripting.FileSystemObject")
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = loggerFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
Don't close the file between calls, let the textstream-object take care of closing when it terminates.
Dim OutputToLogFileObject
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
If IsEmpty(OutputToLogFileObject) Then
strDirectory = "c:\log"
strFile = "\log-"& StampNow & ".bat"
'strText = "test"
strText = strToAdd
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set OutputToLogFileObject = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
End If
OutputToLogFileObject.WriteLine strText
End Function