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")
Related
I am creating a new database for where I work. It is creating quotes for jobs. When I click the save button its save the quote and opens a new folder which gets its name from three fields on the form. I want it to import or copy files from another folder in the directory to the newly created folder.
I have tried to use the copyfolder function and it does copy the files but to the main folder where all the quotes are held and not into the newly created folder.
On Error GoTo btnOK_Click_Error
Const strParent = "C:\Users\r.jones\Desktop\Quotes\ "
Dim Strquotenumber As String
Dim Strsite As String
Dim StrprojDesc As String
Dim strFolder As String
Dim Strspace As String
Strspace = Space(1) & "- "
Strquotenumber = Me.QuoteNumber
Strsite = Me.Txtsite
StrprojDesc = Me.Project_Description
strFolder = strParent & Strquotenumber & Strspace & Strsite & Strspace & StrprojDesc
If Dir(strFolder, vbDirectory) = "" Then MkDir strFolder
Shell "explorer.exe " & strFolder, vbNormalFocus
If Me.Dirty Then DoCmd.RunCommand acCmdSaveRecord
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "Frmquotebook"
btnOK_Click_Exit:
Exit Sub
btnOK_Click_Error:
MsgBox "Error" & " In Attempting To Create New Folder. All Fields Must Be Filled In." & vbCrLf_
Cancel = True
Resume btnOK_Click_Exit
Is it possible to do this as I have not been able to find anything on it.
Thanks for the help.
Here are some file system routines I use, wrapping the Scripting.FileSystemObject Object:
Public Function FileExists(FileName As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
FileExists = fso.FileExists(FileName)
End Function
Public Sub DeleteFile(FileName As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If FileExists(FileName) Then fso.DeleteFile FileName, True
End Sub
Public Sub CopyFile(Source As String, Destination As String, Optional force As Boolean = False)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If FileExists(Source) Then
fso.CopyFile Source, Destination, force
End If
End Sub
Public Sub CreateFolder(Folder As String)
Dim fso As Object
Dim Position As Integer
Dim TempFolder As String
Dim Folders As Object
Dim strArr() As String
Dim i As Integer
Position = 0
TempFolder = ""
strArr = Split(Folder, "\")
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(strArr)
If Not fso.FolderExists(TempFolder & strArr(i) & "\") Then
Set Folders = fso.GetFolder(TempFolder).subFolders
Folders.Add (strArr(i))
End If
TempFolder = TempFolder & strArr(i) & "\"
Next
End Sub
You will need to iterate over each file in the source directory and cop it over to the destination directory
Sub CopyFilesInDirectoryToFolder(SourceDirectory As String, DestinationDirectory As String)
Dim fileName As String
If Not Right(SourceDirectory, 1) = Application.PathSeparator Then SourceDirectory = SourceDirectory & Application.PathSeparator
If Not Right(DestinationDirectory, 1) = Application.PathSeparator Then DestinationDirectory = DestinationDirectory & Application.PathSeparator
fileName = Dir(SourceDirectory)
Do While Len(fileName) > 0
CopyFile SourceDirectory & fileName, DestinationDirectory & fileName
fileName = Dir()
Loop
End Sub
I am trying to open a pdf file through MS Word, perform certain action such as evaluating calculations, printing the files, etc. and then proceed with closing the file. The error message I received is "Microsoft Excel is waiting for another application to complete an OLE action."
I have previously tried hyperlinkfollow and Shell MyPath & " " & MyFile, vbNormalFocus method, it doesn't work. I am still at the starting phase of opening the pdf files, please advice. Thanks!
Sub Extract_PDF_Data()
Dim mainData As String
Dim strFile As String
Dim Oldname As String
Dim Newname As String
Dim Folderpath As String
Dim s As String
Dim t As Excel.Range
Dim wd As New Word.Application
Dim mydoc As Word.Document
Folderpath = InputBox("Folder path: ")
Folderpath = Folderpath & "\"
strFile = Dir(Folderpath & "", vbNormal)
Do While Len(strFile) > 0
Oldname = Folderpath & strFile
Set wd = CreateObject("Word.Application")
Set mydoc = Word.Documents.Open(Filename:=Oldname, Format:="PDF Files",
ConfirmConversions:=False)
mainData = mydoc.Content.Text
mydoc.Close False
wd.Quit
strFile = Dir
Loop
End Sub
Don't us the New keyword in the line that declares the object variable. This will "block" the object variable - it causes the error when the code laters tries to instantiate it. This method can work in VB.NET but not in VBA.
Do it more like this:
Dim wd As Word.Application
Set wd = New Word.Application. 'Or use CreateObject
I think a combination of those three sources will lead to the answer:
How to open a pdf with Excel?
How to extract data from pdf using VBA?
How to open and print a pdf using VBA?
I think it will be something like this:
Sub Extract_PDF_Data()
Dim mainData As String
Dim strFile As String
Dim Oldname As String
Dim Newname As String
Dim Folderpath As String
Dim s As String
Dim t As Excel.Range
Dim Appshell As Variant
Dim ap As String
Dim Browsedir As Variant
Dim f As Variant
Dim KeyWord As String
' This is a suggestion, I use it because it is more convenient than copy-pasting folder paths
Dim FSO As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
' Get Folder over user input
Set Appshell = CreateObject("Shell.Application")
Set Browsedir = Appshell.BrowseForFolder(0, "Select a Folder", &H1000, "E:\Xample\Path")
' check if not cancalled
If Not Browsedir Is Nothing Then
Folderpath = Browsedir.items().Item().Path
Else
GoTo Quit
End If
KeyWord = "The_Materialist_Example"
' go through all files in the folder
For Each f In FSO.GetFolder(Folderpath).Files
' if file is a pdf , open, check for keyword, decide if should be printed
If LCase(Right(f.Name, 3)) = "pdf" Then
' Here the methods suggest different answers.
' You can either use FollowHyperLink or use the Adobe Library to OPEN PDF
' I would write a function that checks the active pdf for the keyword : IsKeyFound
Debug.Print Folderpath & "\" & f.Name
Call PrintPDF(Folderpath & "\" & f.Name)
If IsKeyFound(f, KeyWord) Then
f.Print
End If
End If
Next f
Quit:
End Sub
Private Sub PrintPDF(strPDFFileName As String)
Dim sAdobeReader As String 'This is the full path to the Adobe Reader or Acrobat application on your computer
Dim RetVal As Variant
sAdobeReader = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
'Debug.Print sAdobeReader & "/P" & Chr(34) & strPDFFileName & Chr(34)
RetVal = Shell(sAdobeReader & " /P " & Chr(34) & strPDFFileName & Chr(34), 0)
End Sub
Private Function IsKeyFound(PDF As Variant, KeyWord As String) As Boolean
'Decide if file needs to be printed, insert your criteria and search algorithm here
End Function
I have not been able to figure out how to extract the keywords, you could however use a user input as a first approach and later move on to a automated scan of the pdf.
I hope this gets you further on the way to the solution.
On a monthly basis I have to aggregate daily files. The issue is I need the files to be in "TXT", but they are sent to me as "WRI".
I am able to do one file at a time if it is hardcoded with the following.
Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"
However, I want to be able to loop through the folder. But I am not sure how to change the code to allow it to loop.
Sub ConvertToTXT()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim strPath As String
Dim strFile As String
strPath = "C:\Users\John\Desktop\Folder1\" strFile = Dir(strPath & "*.wri")
Do While strFile <> ""
Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"
Loop
End Sub
I'd personally use the Scripting.FileSystemObject for this - it's much less prone to errors than manually building filepath strings. You'll need to add a reference to Microsoft Scripting Runtime:
Private Sub ConvertToTXT(filePath As String)
With New Scripting.FileSystemObject
Dim directory As Folder
Set directory = .GetFolder(filePath)
Dim target As File
For Each target In directory.Files
If LCase$(.GetExtensionName(target.Name)) = "wri" Then
Dim newName As String
newName = .BuildPath(filePath, .GetBaseName(target.Name)) & ".txt"
.MoveFile target.Path, newName
End If
Next
End With
End Sub
Call it by passing it the directory you want to perform the renaming in:
ConvertToTXT "C:\Users\John\Desktop\Folder1"
Note that is doesn't care if there's a trailing \ or not - this also works:
ConvertToTXT "C:\Users\John\Desktop\Folder1\"
Sub ConvertToTXT()
Const strPath As String = "C:\Users\John\Desktop\Folder1"
Dim strFile As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strFile = Dir(strPath & "\" & "*.wri")
Do While strFile <> ""
Name strPath & "\" & strFile As strPath & "\" & Replace(strFile, ".wri", ".txt")
strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
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
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