I need to detect whether the Print Spooler service is running. I can find various resources for VB.NET (e.g., using ServiceProcess.ServiceController to actually manipulate the service), but nothing for VB6.
Is there any way to check whether the Print Spooler is running in VB6? And ideally start it, but I can survive without that.
We use wmi in VBA/VB6/VBScript and command prompt.
This lists processes
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
msgbox objitem.name & " PID=" & objItem.ProcessID & " SessionID=" & objitem.sessionid
' objitem.terminate
Next
This is typed an command prompt.
wmic process get
You'll see you can get VBS methods/properties by using wmic help
wmic /?
wmic process /?
wmic process get /?
So wmic service get caption,status
so
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Service")
For Each objItem in colItems
msgbox objitem.name & " " & objitem.status
Next
Since there's only one Print Spooler, you can query the Win32_Service class for the single instance. Then, check the Started property to determine if it's started/running:
Set objSpooler = GetObject("winmgmts:root\cimv2:Win32_Service.Name='Spooler'")
If objSpooler.Started Then
MsgBox "Print Spooler is running."
Else
MsgBox "Print Spooler is NOT running."
End If
Both answers already posted are good (and will solve the problem) but I just wanted to answer my own question to incorporate an answer given elsewhere (By user Bonnie West over at VBForums.com), as it gives an additional approach and is probably useful for anyone else who finds this question:
Option Explicit 'In a standard Module
Private Sub Main()
With CreateObject("Shell.Application") 'Or New Shell if Microsoft Shell Controls And Automation is referenced
If .IsServiceRunning("Spooler") Then
.ServiceStop "Spooler", False
Else
.ServiceStart "Spooler", False
End If
End With
End Sub
Source
Related
I was just upgraded to windows 10. This version of outlook I have enabled the macros in the trust center however it limits me on running vba from outlook. Also access is having issues when I run the task scheduler and run from a bat file the access database. An autoexec excutes and I tell the system to shut outlook down but it won't shut down the current instance of the outlook. Here Is the code I am using.
Public Function OutlookClose1()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
Set objOutlook = GetObject(Class:="Outlook.application")
objOutlook.Quit
Next
End Function
Public Function OutlookClose2()
Dim objAppOL As Outlook.Application
On Error Resume Next
Set objAppOL = GetObject(Class:="Outlook.application")
objAppOL.Quit
Set objAppOL = Nothing
Exit Function
End Function
I have tried outlookclose1 and 2 and neither work. DOes anyone have suggestions?
Also when running the outlookclose1 from the vba editor it does close. It takes the exchange offline, which I don't want. But from a bat file running the access database and having the autoexec run it it doesn't close down outlook.
Task scheduler runs as a service in a security context different from the currently logged in user even if the local user account is the same. COM system refuses to marshal calls between processes running in different security contexts.
I have office 2013 and windows 10. I could use the above code with Windows 7 and the task scheduler. I am on a domain with certain policies that I can't change and I don't have admin rights. At home not on a domain I can use that code too. With that being said I can at least terminate outlook from access and get the job done closing an outlook session so when the autoexec runs in the access database it closes outlook and then runs the reports and sends, Create Object Outlook.Application and it sends emails no problems. Here is how I terminate the code. The reason is I don't want multiple outlook sessions running.
Public Function OutlookClose1()
Dim objOutlook As Outlook.Application
delay = 30000 'delay in milliseconds to let Outlook close gracefully
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
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 Function
I spend hours finding the problem.
I want to start the SAP Logonpad with the ini file, that works fine.
Then after binding to the scripting object I want to open the connection to a specific System with connection = SapGui.OpenConnection("SID", True)
but always get runtime error 70 access denied.
I followed what others seem to do with vbs, for certain resons I can't do it with vbs and have to go with vba, so maybe there might be some difference that makes it fail?
Any advice would be highly appreciated.
Private Sub CommandButton1_Click()
Dim SapGui As Object
Dim saplogon As Object
Dim connection 'As Object
Set SapGui = GetObject("SAPGUI")
Dim Wshshell As Object
Set Wshshell = CreateObject("Wscript.Shell")
Wshshell.Run Chr(34) & ("C:\Program Files\SAPPC\FrontEnd\SAPgui
\saplogon.exe") & Chr(34) & " " & "/INI_FILE" & "=" & Chr(34) &
"\\longpathtoini\appl\Sap\saplogon\int\saplogon.ini" & Chr(34)
Do Until Wshshell.AppActivate("SAP Logon")
Application.Wait Now + TimeValue("0:00:01")
Loop
Set Wshell = Nothing
Set saplogon = SapGui.GetScriptingEngine
connection = SapGui.OpenConnection("SID", True)
Set SapGui = Nothing
Set saplogon = Nothing
Set connection = Nothing
End Sub
Check whether user scripting is allowed for the particular system (transaction RZ11, parameter sapgui/user_scripting). Also be aware that for some versions, you'll apparently need to specify the SAP Logon entry text instead of the SID.
Thanks to vwegert.
I surely knew about scripting needs to be enabled on the servers.
Which is, but at the moment I read his answer I remembered that in my SAP GUI settings the checkbox for "Warn if a script tries to connect" was enabled.
Disabeling that options did lead to success.
The above code works perfectly.
I made a script that copying a file to a certain location.
I add the .vbs to taskschd.msc scheduled for make a .pst backup
but I get error message
Line: 91
Char: 7
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
<pre>
'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) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de#teknotrans.se.pst"
pst(1) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de.pst"
'Define your backup location
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
'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
If fso.FolderExists(BackupPath) = False Then
fso.CreateFolder BackupPath
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
</pre>
Could someone help me to solve this?
Thank you in advance
Seems like you schedule the script.
You need to start the task with a user that executes the script which has rights on the PST file, as well as on the path where you store the backup. Running it with the system account won't be enough.
There are better ways to backup PST files also, I use a Ruby script to synchronise a local copy with a backup copy, is runs on PST's more than 10GB big without problem, might be a problem if you would do it with a copy like this.
You need to backup the copy on a backup medium also because when the PST has errors (and all big PST have) you copy the errors to the backup and could lose both.
Also, you do the following
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
...
BackupPath = BackupPath & ArchiveFolder & "\"
Where is the \ between the two first variables ?
EDITED: Change the permissions of the folder.
In windows explorer, navigate to the folder where the PST file is located.
In the left pane of windows explorer, right click on the folder where the PST file is located, select "Properties".
Select the "Security" tab
Click the button "Edit" to change permissions.
Click "Add"
In the object names to select box, enter "everyone" (no quotes).
Click "Check Names", everyone should become capitalized and underlined.
Click "Ok"
Select "Everyone" from the list of Groups or user names.
In the "Permissions for Everyone" list, make sure "Read & Execute, List folder contents and Read, in the allow column are checked, click "Apply"
Click Ok.
NOTE: By doing this, anyone who has access to this computer can access the folder. You might consider only adding your login to the computer to the list of Groups or usernames instead of Everyone. You may have to repeat the above steps on the PST file(s) in question.
Original Post:
I ran the script here, testing for various issues and it ran without problems. At this point I believe the issue is rights and permissions to either the source or destination folder (or the files you are backing up). By default, the user's themselves don't have access to Outlooks data files. You would need to add "read" permissions to the files in question (PST,OST, and so on) or the full folder.
In reality, just backing up the PST files isn't enough to restore an Outlook configuration; you would need all of the files.
You can Try this:
'===================================================================
'Description: VBS script to backup your pst-files.
'
'Comment: Before executing the vbs-file, set the location of outlook
' folder you want to backup and
' the backup location (this can also be a network path).
' See the URL below for more configuration instructions and
' how to create a Scheduled Task for it.
'
' Original author : Robert Sparnaaij
' Modified: Fred Kerber
' version: 1.1
' website: http://www.howto-outlook.com/downloads/backupscript.htm
' Changes:
' Changed var types; changed to backup full folder and not just pst files.
'===================================================================
'===================BEGIN MODIFY====================================
'Define the folder location of Outlook's data files.
sOutlookDataPath = "C:\Users\FKerber.CORP\AppData\Local\Microsoft\Outlook\"
'Define your backup location
sBackupPath = "E:\Outlook Backup\"
'Keep old backups? TRUE/FALSE
bKeepHistory = TRUE
'Maximum time in milliseconds for Outlook to close on its own
iDelay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
bStart = True
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(iDelay)
'Outlook is closed, so we can start the backup
Call BackupOutlook(sOutlookDataPath, sBackupPath, bKeepHistory)
'Open Outlook again when desired.
If bStart = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(iDelay)
Set objWMIService = GetObject("winmgmts:" &_
{impersonationLevel= impersonate}!\\.\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each oProcess in objWMIService.InstancesOf("Win32_Process")
If StrComp(oProcess.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 BackupOutlook(sOutlook, sBackupPath, bKeepHistory)
Set ofso = CreateObject("Scripting.FileSystemObject")
If bKeepHistory = True Then
sArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
sBackupPath = sBackupPath & sArchiveFolder & "\"
Else
For Each oFile In ofso.GetFolder(sBackupPath).Files
ofso.DeleteFile oFile.Path, True
Next
End If
If ofso.FolderExists(sBackupPath) = False Then
ofso.CreateFolder sBackupPath
End If
For Each oFile In ofso.GetFolder(sOutlook).Files
If ofso.FileExists(oFile.Path) Then
ofso.CopyFile oFile.Path, sBackupPath, True
End If
Next
Set ofso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
I had a similar problem trying to delete files with VBS. I assume that as with my case: The source of the problem is that the script is trying to perform some operation on a file or folder that has a Read-only Attribute. To solve this manually you could left click -> properties -> unclick the Read-Only Attribute then the file/folder should be copied by the script. To solve the problem with VBS: I make the assumption that file/folder is set to Read-Only because there is a programme currently using them.
One: we can just skip files/folders set to read-only this time and hope to get them next time the script runs. For this we first check if file/folder is read-only (I got this from here: https://social.technet.microsoft.com/Forums/ie/en-US/7382d452-1ef9-404a-8874-48d38fcfe911/vbscript-verify-if-a-file-is-readonly?forum=ITCG), if not then we perform the copy operation.
Sub BackupPST(pst, BackupPath, KeepHistory)
'........
For Each pstPath in pst
If fso.FileExists(pstPath) Then
If not (fso.GetFile(pstPath).Attributes AND 1) Then 'if item is not read-only
fso.CopyFile pstPath, BackupPath, True
End If
End If
Next
Set fso = Nothing
End SubSub
Two: At the very least this should prevent you from getting the error. But if the script never moves the files even after running a number of times then chances are that the files (you are trying to move) are always in read only and you should change Attribute of the file (you are trying to move) in your script before calling the copy function, see how to do that here: https://devblogs.microsoft.com/scripting/how-can-i-change-a-read-only-file-to-a-read-write-file/
I am trying to ping a server before uploading a file with ftp. Recently, a client complained that the process was freezing. I tested the ping process with a vbscript file just to make sure something wasn't broken on the computer. The vbscript worked just fine. So I ran the script from the Access database and it hung just the same as it did before. Is there something about the ping exe that I am missing here?
Vbscript that runs just fine when you double click it.
Const fsoForWriting = 2
Dim oShell, ping, strPath, strPing
Set oShell = WScript.CreateObject ("WScript.Shell")
Set ping = oShell.exec("ping -n 2 -w 750 google.com")
Do While ping.Status = 0
WScript.Sleep 100
Loop
strPing = ping.StdOut.ReadAll
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = objFSO.GetParentFolderName(strPath) & "\PingResults.txt"
Set objTextStream = objFSO.OpenTextFile(strTextFile, fsoForWriting, True)
objTextStream.WriteLine strPing
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Set oShell = Nothing
VBA function that runs on the test database on startup. This is the code that hangs.
Function fFtpOnline(ByVal ComputerName As String)
On Error GoTo ErrHandler
Dim oShell, ping
Set oShell = CreateObject("WScript.Shell")
Set ping = oShell.exec("cscript " & Access.CurrentProject.Path & "\" & "Test.vbs")
Do While ping.Status = 0
DoEvents
Loop
Set oShell = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description & " " & "fFtpOnline "
Resume Next
End Function
This code works fine on my computer but on the client's computer, the code hangs.
This may sound like a rude answer, but by no means is it intended to be. Just as the comment above stated, this is more than likely it issue on your customer's end. If the program works currently on your end and not theirs they have the issue, not the code. I've run into plenty of customers who are clueless so unless they are willing to let you take control of their machine remotely I would recommend them capturing some information for you. ipconfig is a good place to start. And while they are at the command prompt have them try to ping some places. I know this is not a true answer, but it is what I have encountered in the past.
What would a safe way of extracting the 'Program Files' directory location using VBS?. I would like to get the directory location from the environment as it will avoid localization issues as well as problems between different OS architectures (32/64 bit) and drive (C:\, D:\, etc:).
So far I came across an example given on MSDN yet I can get the script to work in VBS, every run just complains about different errors. Here is what they've got on an example script for .net to get the Sys32 folder.
' Sample for the Environment.GetFolderPath method
Imports System
Class Sample
Public Shared Sub Main()
Console.WriteLine()
Console.WriteLine("GetFolderPath: {0}", Environment.GetFolderPath(Environment.SpecialFolder.System))
End Sub 'Main
End Class 'Sample
'
'This example produces the following results:
'
'GetFolderPath: C:\WINNT\System32
'
As Helen mentioned, this is my script to determine the OS Architecture and depending on the outcome I wish to retrieve the respective 'Program Files' path
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & sPC & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
sSystemArchitecture = objOperatingSystem.OSArchitecture
Next
for vbs from How to get program files environment setting from VBScript
Set wshShell = CreateObject("WScript.Shell")
WScript.Echo wshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
if you are in vba
Sub GetMe()
Set wshShell = CreateObject("WScript.Shell")
MsgBox wshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
End Sub