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
Related
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 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
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.
I need to save, move and delete a file. But when I do that I want to let it save my files in the documents of the user that is logged on.
Here is my code:
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
objDoc.SaveAs("userprofile & "\Downloads\test.doc")
objWord.Quit
Const strFolder = "userprofile & "\Downloads\System Information\", strFile = "userprofile & "\Downloads\test.doc"
Const Overwrite = True
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
oFSO.CopyFile strFile, strFolder, Overwrite
oFSO.DeleteFile("userprofile & "\Downloads\test.doc")
In VBScript, you can't use string concatenation (&) when defining constant values. Use variables instead.
Also, you have an extra quote before the userprofile variable name.
Here's the fixed code:
...
objDoc.SaveAs(userprofile & "\Downloads\test.doc")
Dim strFolder : strFolder = userprofile & "\Downloads\System Information\"
Dim strFile : strFile = userprofile & "\Downloads\test.doc"
...
oFSO.DeleteFile(userprofile & "\Downloads\test.doc")
I have a table and a text file. Once the records in the table copied into textfile, the records will be deleted. But the table are still in used and will be inserted with a new records from time to time(by another program). I what to do checking on How to make sure that if there are no records in the table, the program will never copy into textfile.
Any solution, or references are very thankful. Thank you very much. Im testing in WSH and using MSSQL Server 2005.
'call functions
call CopyFile()
call tblDelete()
Sub tblDelete()
Dim sql1
sql1 = "DELETE from tblOutbox"
rs = conn.Execute(sql1)
End Sub
Sub CopyFile
'set the sql command
cmd.CommandText = "SELECT * FROM tblOutbox"
cmd.CommandType = 1 ''# adCmdText Command text is a SQL query
Dim rs : Set rs = cmd.Execute
'create obj for the FileSystem
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile, objFolder
Dim strDir, strFile
strDir = "c:\"
strFile = "\newFile.txt"
'check that the strDirectory folder is exist
If objFSO.FolderExists(strDir) Then
Set objFolder = objFSO.GetFolder(strDir)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
WScript.Echo "Just created " & strDir
End If
If objFSO.FileExists(strDir & strFile) Then
Set objFolder = objFSO.GetFolder(strDir)
Else
Set objFile = objFSO.CreateTextFile(strDir & strFile)
Wscript.Echo "Just created " & strDir & strFile
End If
Set objFile = Nothing
Set objFolder = Nothing
'open files and copy into
Dim objtextStream : Set objtextStream = objFSO.OpenTextFile(strDir & strFile, 8, True)
Do Until rs.EOF
objtextStream.Write rs("id") & ", "
objtextStream.Write rs("ip") & ", "
objtextStream.Write rs("msg") & ", "
objtextStream.WriteLine rs("date")
rs.MoveNext
Loop
objTextStream.WriteLine
objTextStream.WriteLine "Report Generate at " & Now
objTextStream.WriteLine "--------------------------------------------"
objtextStream.Close
rs.Close
End Sub
You could put
If rs.RecordCount > 0 Then
exit sub
End If
before
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile, objFolder
i.e. Don't execute any of the statements, if there are no records.
Can you set your code up in a format such as the following, in which you delay opening the output file until after you have fired your query and retrieved at least one response:
Set up SQL statement
Execute SQL query
init bFirstRecord as true
Loop over results
if bFirstRecord
check folder and file existence, create as necessary
open output file
bFirstRecord = false
end if
write record to output
End Loop
Close up files, etc