I want to send the contents of a folder in an email and then delete the folder and the contents.
The code below works, except that it deletes only the contents of the folder and then gives me a Run-time error 70 - Permission denied and leaves the folder. The DeleteAFolder sub works if I run it separately and define strFolder. So it seems that it's somehow an issue of something still being in use, but I can't figure what or how to close it. It's only an empty folder that I can't delete. The files have already been sent in the email and deleted.
Sub SendMultiDocsEmail()
strFolder = "C:\Users\UserID\Desktop\Admin"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Testing my files email"
objMessage.From = "myemail#company.com"
objMessage.To = "myemail#company.com"
objMessage.TextBody = "This is a test, files should be attached to this email."
For Each objFile In objFolder.Files
strFileExt = objFSO.GetExtensionName(objFile.Path)
objMessage.AddAttachment objFile.Path
'objFile.Close
' Run-time error 438 - Object doesn't support this property or method
Next
'Configuration Info
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.company.com"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
'strFolder.Close
' Run-time error 424 - Object required
'objFolder.Close
' Run-time error 438 - Object doesn't support this property or method
'Tried adding the Set to Nothing lines - didn't change result
'Set objFSO = Nothing
'Set objFolder = Nothing
DeleteAFolder (strFolder)
End Sub
Sub DeleteAFolder(strFolder)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder (strFolder)
End Sub
Related
I have written VBScript to delete the files from the folder which are 30days older. even I need to add entry in log file. But here I need to list the name of the files which got deleted in log file. while doing that I am getting error.
Const strPath = "D:\TextReport\"
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set LogFile = objFSO.CreateTextFile("D:\Text\ASD.txt", true)
LogFile.WriteLine "DateTime: " & Now
LogFile.WriteLine "UserName: " & CreateObject("WScript.NetWork").UserName
Call Search (strPath)
' Comment out below line if you'd like to use this script in windows schedule task
WScript.Echo"Done."
Sub Search(str)
Dim objFolder, objSubFolder, objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
' Use DateLastModified for modified date of a file
If objFile.DateLastModified < (Now() - 30) Then
objFile.Delete(True)
End If
LogFile.WriteLine (objFolder.Files.Item.Name)
Next
For Each objSubFolder In objFolder.SubFolders
Search(objSubFolder.Path)
' Files have been deleted, now see if the folder is empty.
If (objSubFolder.Files.Count = 0) Then
objSubFolder.Delete True
End If
Next
End Sub
LogFile.Close
WScript.Echo "Finished"
You are trying to get the name of a file that you deleted. Log the name inside the date check.
If objFile.DateLastModified < (Now() - 30) Then
LogFile.WriteLine objFile.Name
objFile.Delete(True)
End If
I was trying to build a VBS to test creating files because a larger script I wrote isn't creating an output file. The point of the following script is to test functionality; which I'm not currently seeing.
Option Explicit
Dim objFSO, objFSOText, objFolder, objFile
Dim strDirectory, strFile
strDirectory = "C:\Test\next"
strFile = "\Try.txt"
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Create the Folder specified by strDirectory on line 10
Set objFolder = objFSO.CreateFolder(strDirectory)
' -- The heart of the create file script
'-----------------------
'Creates the file using the value of strFile on Line 11
' -----------------------------------------------
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
Wscript.Echo "Just created " & strDirectory & strFile
Wscript.Quit
While running this code, everything works the first time but there isn't an output file in the destination directory. When I run it again it throws an error that the file already exists.
I think the problem is that you are trying to create the path "C:\Test\next", which is a structure of two nested folders) in one go and also do not test if that path already exists.
To create a nested folder structure, I have added a small helper function CreateNestedFolder to your code and tidied it up a bit:
Option Explicit
Dim strDirectory, strFile, overwrite
strDirectory = "C:\Test\next"
strFile = "Try.txt"
overwrite = True 'set this to False if you do not wish to overwrite an existing file
'Create the (nested) Folder Structure specified by strDirectory if it does not exist yet
If Not CreateNestedFolder(strDirectory) Then
Wscript.Echo "Could not create folder " & strDirectory
Else
Dim objFSO, objFile
' Create the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' -- The heart of the create file script
'-----------------------
'Creates the file using the value of strFile
' -----------------------------------------------
'combine the directory and filename
strFile = strDirectory & "\" & strFile
'Create the new file and write something in it
Set objFile = objFSO.CreateTextFile(strFile, overwrite)
objFile.WriteLine("This is a test.")
objFile.Close
Wscript.Echo "Just created " & strFile
'Clean up the used objects
Set objFile = Nothing
Set objFSO = Nothing
End If
Function CreateNestedFolder(ByVal sPath)
'Helper function to create a nested folder structure.
'Returns True on success, False otherwise
Dim aFolders, oFso, i, firstIndex
On Error Resume Next
Set oFso = CreateObject("Scripting.FileSystemObject")
'Check if the path already exists
If Not oFso.FolderExists(sPath) Then
'Find the root drive and split the path in subfolder parts
aFolders = Split(sPath, "\")
'Get the root path from the complete path
If Left(sPath, 2) = "\\" Then
'If this is a UNC path then the root will be "\\server\share"
sPath = "\\" & aFolders(2) & "\" & aFolders(3)
firstIndex = 4
Else
'For a local path, the root is "X:"
aFolders = Split(sPath, "\")
sPath = aFolders(0)
firstIndex = 1
End If
'Loop through the aFolders array and create new folders if needed
For i = firstIndex to UBound(aFolders)
If Len(aFolders(i)) > 0 Then
sPath = sPath & "\" & aFolders(i)
If Not oFso.FolderExists(sPath) Then oFso.CreateFolder sPath
End If
Next
End If
CreateNestedFolder = (Err.Number = 0)
On Error GoTo 0
Set oFso = Nothing
End Function
I have this code that copies outlook PST files, and when used with the full location file path it runs perfectly fine. I've added a method to run %UserProfile% in the first line as this needs to be run in a domain context from GPO and doing it individually is non-feasible. This runs and closes outlook and reopens it at the appropriate time except one thing is amiss.
It is no longer copying the appropriate files. I echoed the initial %userprofile% sections and it is reading the correctly as "drive letter"\users\userprofile. I'm not sure where this is breaking or how to identify it.
'===================BEGIN MODIFY====================================
Set objShell = CreateObject("WScript.Shell")
userProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = "%UserProfile%\Documents\Outlook Backups\"
'Keep old backups? TRUE/FALSE
KeepHistory = FALSE
'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
start = TRUE
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(delay)
'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)
'Open Outlook again when desired.
If start = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(delay)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each Process in objWMIService.InstancesOf("Win32_Process")
If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
set colProcessList = Nothing
End Sub
Sub BackupPST(pst, BackupPath, KeepHistory)
Set fso = CreateObject("Scripting.FileSystemObject")
If KeepHistory = True Then
ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
BackupPath = BackupPath & ArchiveFolder & "\"
End If
For Each pstPath in pst
If fso.FileExists(pstPath) Then
fso.CopyFile pstPath, BackupPath, True
End If
Next
Set fso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
When you declared userProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%"), you put the path of %UserProfile% in the variable named userProfilePath, but afterward you don't use this variable. That's a problem, because a few lines down, what you end up doing is declaring pst(#) with %userprofile% as a string, which doesn't work.
In other words, the %UserProfile% environment path/string needs to be expanded before being used as a path.
Your code would work if you used the userProfilePath variable you declared:
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = userProfilePath+"\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = userProfilePath+"\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = userProfilePath"\Documents\Outlook Backups\"
instead of
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = "%UserProfile%\Documents\Outlook Backups\"
I have the following VBScript to which I'm trying to add to, but I need help in how to do it.
At present I have the script below that asks for the file name I want it to be called and then creates a folder and moves of which ok.
What I'm trying to add is after the folder is created I need a command box with the YES/NO option and if I click YES I need the file moved to C:\DOCUMENTS\A and if NO I need it moved to C:\DOCUMENTS\B.
Once I've clicked YES or NO and it has moved the folder I need to open Folder A or B to view.
Any Ideas?
Option Explicit
Const strDLFolder = "C:\Downloads"
Dim objFSO, objWShell, objDLFolder, strNewFolder, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWShell = CreateObject("WScript.Shell")
If Not objFSO.FolderExists(strDLFolder) Then objFSO.CreateFolder(strDLFolder)
objWShell.CurrentDirectory = strDLFolder
Set objDLFolder = objFSO.GetFolder(strDLFolder)
If objDLFolder.Files.Count = 0 Then WScript.Quit
Do
Err.Clear
strNewFolder = InputBox("Folder Name", vbLf & "Enter the name of the folder to be created:")
If strNewFolder = False Then WScript.Quit
On Error Resume Next
objFSO.CreateFolder strNewFolder
Loop While Err.Number <> 0 Or Not objFSO.FolderExists(strNewFolder)
On Error Goto 0
For Each objFile In objDLFolder.Files
objFSO.MoveFile objFile.Name, strNewFolder & "\"
Next
objWShell.Popup "All files moved.", 0, "Done", vbInformation Or vbSystemModal Or &h00040000&
In my code segment, when I script the file name, it gives me a permission denied
on the following line:
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
Here is the script
'output log info
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\eNet"
strFile = "\weeklydel.bat"
'strText = "Book Another Holiday"
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 = 2
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
I have assigned the vbscript domain administrator permissions. Any ideas?
thanks in advance
I don't think this has to do with File Permissions per se. It has to do with the fact that you've created the file using:
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
That creates the file...and carries a reference to that file (objFile)
Then you don't close the file before you destroy the reference
...
'Missing objFile.Close here
Set objFile = nothing
Set objFolder = nothing
...
Consequently you're destroying the reference but leaving the textstream open in memory thus locking your file.
You are then proceeding to attempt to re-open the file while the file is already "open". This is a little long winded, you've already got a reference after you've created the file - it would be easier just to write straight to that rather than destroy the reference before creating another one.
for what its worth...
I was convinced I had a permission error because of this line:
Set LogFile = LogFSO.OpenTextFile(LogFileName, ForWriting, True)
Because that's the line that the 'permission denied' error pointed to. But in fact, my permission error was a few lines further down:
WshShell.AppActivate(ScreensToRemove(i))
WshShell.SendKeys ("~")
WScript.Sleep(1000)
There was no screen with such a caption, so the SendKeys is what did not have permission.
The solution, of course, was:
If WshShell.AppActivate(ScreensToRemove(i)) = True Then
WshShell.SendKeys ("~")
WScript.Sleep(1000)
End if
Hope that might help.
Also, make sure that you don't have the file open in Excel (I had this problem with a .csv file)...
In my particular case the file which existed before and all I had to do was give permission to the Everyone user
balabaster is exactly right. You either need to close the file before reopening it a second time for writing, or using the existing open handle.