Aug 31

Remove RDS CALs from RDS Server

Posted on August 31, 2017 by Managed WordPress Migration User

Background

There are many circumstances where you will need to remove a RDS CALs from an RDS Server, or in some cases you want to rebuild the entire RD licensing database. Microsoft allows you to remove an individual CAL license pack using powershell, or rebuild the entire database. However, if neither of those work, it’s quite easy to manually rebuild the RD licensing database. I’ve included directions for all 3 methods below, and have tested this on Windows Server 2008, 2008R2, 2012, 2012R2, and 2016.

Remove An Individual RDS CAL License Pack Using Powershell (User or Device CAL)

Open powershell elevated as an administrator
Type the following command to list the RDS Licenses and note the KeyPackID
- Alternatively, open RD Licensing Manager and note the Keypack ID

Get-WmiObject Win32_TSLicenseKeyPack

1	Get-WmiObject Win32_TSLicenseKeyPack

Run the below command to remove the licenses pack from your RD Server
- Replace KEYPACKID with the number you obtained above

wmic /namespace:\\root\CIMV2 PATH Win32_TSLicenseKeyPack CALL UninstallLicenseKeyPackWithId KEYPACKID

1	wmic /namespace:\\root\CIMV2 PATH Win32_TSLicenseKeyPack CALL UninstallLicenseKeyPackWithId KEYPACKID

Rebuild the RD Licensing Database

Microsoft provides directions on how to do this automatically, via a web browser, or via the phone:

https://technet.microsoft.com/en-us/library/dd851428.aspx

Manually Rebuild the Licensing Database (Guaranteed to Work if the Previous 2 methods Fail)

Make sure you have documentation of your MS License agreement that includes Authorization number, License number, License type (User/Device CAL), and Quantity before proceeding
Stop the Remote Desktop Licensing service

Rename C:\Windows\System32\lserver\TLSLic.edb to C:\Windows\System32\lserver\TLSLic.old
Start the Remote Desktop Licensing service
All licenses will now be cleared out of RD Licensing Manager, and you’ll need to re-install the licenses you want to add back in

Oct 28

Missing Power and Search Button On Start Screen

Posted on October 28, 2016 by Managed WordPress Migration User

Missing Power and Search Button On Start Screen on Server 2012 R2 and Windows 8.1

Recently, after installing a Windows 2012 R2 Server VM, I noticed the Start screen was missing the Power and Search buttons. All of my older Server 2012 R2 Server VM’s had the Power and Search button on the start screen, I used the same ISO to install, and Windows was 100% up to date. After researching, this issue can affect Windows Server 2012 R2 as well as Windows 8.1. Here is a screenshot of my Start screen missing both the Power and Search buttons:

The Solution

The short answer is KB2919355 needs installed. HOWEVER, you need to make sure you install the following updates in this order:

Prerequisite: KB2919442
Install KB2919355 that has multiple downloads in it, which can be directly downloaded from the Microsoft Download Center
1. Windows 8.1 x86
2. Windows 8.1 x64
3. Server 2012 R2 x64
4. NOTE: Once downloaded, these updates need installed in the following order
  1. clearcompressionflag.exe
  2. KB2919355 (Reboot after installation, if fixed you can skip the rest)
  3. KB2932046
  4. KB2959977
  5. KB2937592
  6. KB2938439
  7. KB2934018

Once KB2919355 is installed and you reboot, you should now see the Power and Search buttons on the start screen as displayed below:

Final Notes

Once KB2919355 is installed, run Windows Updates and you’ll probably need to install a few hundred updates again

Sep 22

Move Off-Screen Window in Windows

Posted on September 22, 2016 by Managed WordPress Migration User

Have you ever had a window that ended up off of your screen and were unable to move it back into view? I’ve personally had this occur after disconnecting a monitor from my laptop which I had my desktop extended on. However, there’s a simple trick to move the Window back into view of your desktop.

Make the Off-Screen Window Active

Hold the Alt key down and then press Tab key until you’ve selected the Window that is off-screen

Select Move for the Active Window

Hold the Alt key down, press the Space-bar key, then press the M key

Move Your Window Back Into View

You can now move the window in the desired direction with the arrow keys

Feb 18

Mail Merge with Attachment

Posted on February 18, 2015 by Managed WordPress Migration User

There is not native way to add an attachment when doing an mail merge in Microsoft Office (Outlook/Word/Excel). However, there are 3rd party apps that allow you to add attachments when doing a mail merge, but these programs usually cost $. If you’re like me and don’t want to spend money on an application you’ll probably use once, then I came up with an alternative free solution with Powershell. This method works similar to a Microsoft Office mail merge because it will require a data source, email template, and an Outlook profile.

Step 1 – Create Data Source

I will use a users.csv as the data source of users we want to email. The users.csv file will look as follows:

FirstName	LastName	Email	Username	Password
Joseph	smith	jsmith@domain.com	jsmith	VideoGame01
Bill	Contoso	bcontoso@company.com	bcontoso	LilyFlower18
Jim	Rufus	jim.rufus@yahoo.com	jrufus	StuffedAnimal23

Step 2 – Create Outlook Profile to Send Mail Merge From

Now that you have your data source, you’ll need to make sure you have an Outlook profile. This profile should be setup with the email address you wish to send the mail merge from.

Step 3 – Create Powershell Script

In the below powershell script, you’ll need to modify the following variables:

$DataSource – Path to the data source (users.csv) file created in step 1
$AttachFile – Path to the file to attach to the email
$EmailSubject – Subject of the email

In addition to modifying the above variables, you’ll need to modify $Mail.Body, which is the body of the email. The below example is referencing data fields in users.csv for the mail merge, which you may want to modify. These correspond as follows:

$($_.FIRSTNAME) – FIRSTNAME field in users.csv

$($_.LASTNAME) – LASTNAME field in users.csv

$($_.USERNAME) – USERNAME field in users.csv

$($_.PASSWORD) – PASSWORD field in users.csv

Special Note: To add a new line in the body text use a backtick + n ( `n)

$DataSource = "C:\mailmerge\users.csv"
$AttachFile = "C:\mailmerge\Setup Email Directions.docx"
$EmailSubject = "How to Setup Email"

Import-CSV $DataSource | Foreach-Object {
	$ol = New-Object -comObject Outlook.Application  
	$Mail = $ol.CreateItem(0)
	$Mail.Recipients.Add($_.EMAIL)	
	$Mail.Attachments.Add($AttachFile)
	$Mail.Subject = $EmailSubject	
	$Mail.Body = "$($_.FIRSTNAME) $($_.LASTNAME),`n`n"
	$Mail.Body += "The attached directions will guide you through setting up your email account.  Your username and password are as follows:`n`n"
	$Mail.Body += "Username: $($_.USERNAME)"
	$Mail.Body += "Password: $($_.PASSWORD)`n`n"
	$Mail.Body += "If you have any issues installing, please contact support"
	$Mail.Send()
}

$DataSource = "C:\mailmerge\users.csv"

$AttachFile = "C:\mailmerge\Setup Email Directions.docx"

$EmailSubject = "How to Setup Email"

Import-CSV $DataSource | Foreach-Object {

$ol = New-Object -comObject Outlook.Application

$Mail = $ol.CreateItem(0)

$Mail.Recipients.Add($_.EMAIL)

$Mail.Attachments.Add($AttachFile)

$Mail.Subject = $EmailSubject

$Mail.Body = "$($_.FIRSTNAME) $($_.LASTNAME),`n`n"

$Mail.Body += "The attached directions will guide you through setting up your email account. Your username and password are as follows:`n`n"

$Mail.Body += "Username: $($_.USERNAME)"

$Mail.Body += "Password: $($_.PASSWORD)`n`n"

$Mail.Body += "If you have any issues installing, please contact support"

$Mail.Send()

}

Extra Special Note: If you want to have the email body be HTML formatted instead of Plain Text, just modify $Mail.Body to $Mail.HTMLBody and add your HTML tags in the text. Using the example above:

$DataSource = "C:\mailmerge\users.csv"
$AttachFile = "C:\mailmerge\Setup Email Directions.docx"
$EmailSubject = "How to Setup Email"

Import-CSV $DataSource | Foreach-Object {
	$ol = New-Object -comObject Outlook.Application  
	$Mail = $ol.CreateItem(0)
	$Mail.Recipients.Add($_.EMAIL)	
	$Mail.Attachments.Add($AttachFile)
	$Mail.Subject = $EmailSubject	
	$Mail.HTMLBody = "<html><body>"
        $Mail.HTMLBody += "<h1>$($_.FIRSTNAME) $($_.LASTNAME),</h1>"
	$Mail.HTMLBody += "<p>The attached directions will guide you through setting up your email account.  Your username and password are as follows:</p>"
	$Mail.HTMLBody += "<p>Username: $($_.USERNAME)</p>"
	$Mail.HTMLBody += "<p>Password: $($_.PASSWORD)</p>"
	$Mail.HTMLBody += "<p>If you have any issues installing, please contact support<p></body></html>"
	$Mail.Send()
}

$DataSource = "C:\mailmerge\users.csv"

$AttachFile = "C:\mailmerge\Setup Email Directions.docx"

$EmailSubject = "How to Setup Email"

Import-CSV $DataSource | Foreach-Object {

$ol = New-Object -comObject Outlook.Application

$Mail = $ol.CreateItem(0)

$Mail.Recipients.Add($_.EMAIL)

$Mail.Attachments.Add($AttachFile)

$Mail.Subject = $EmailSubject

$Mail.HTMLBody = "<html><body>"

$Mail.HTMLBody += "<h1>$($_.FIRSTNAME) $($_.LASTNAME),</h1>"

$Mail.HTMLBody += "<p>The attached directions will guide you through setting up your email account. Your username and password are as follows:</p>"

$Mail.HTMLBody += "<p>Username: $($_.USERNAME)</p>"

$Mail.HTMLBody += "<p>Password: $($_.PASSWORD)</p>"

$Mail.HTMLBody += "<p>If you have any issues installing, please contact support<p></body></html>"

$Mail.Send()

}

Step 4 – Send the Mail Merge

Open Microsoft Outlook with the profile created in step 2 (It is required for Outlook to be open in order for the powershell script to work!) Then open Powershell, and run the powershell script in step 3. You can confirm the emails are sending by looking in the “Sent Items” in Outlook.

Note: – If you’re using User Account Control (UAC), Outlook and Powershell must be running at the same security level. This simply means, if you open powershell using “Run as administrator” you must open Outlook with “Run as administrator”. Alternatively, if you open powershell normally (not elevated) you must open Outlook normally (not elevated).

Feb 11

Removing Trend Micro Client/Server Security Agent from Dell Laptops

Posted on February 11, 2015 by Managed WordPress Migration User

Trend Micro Client/Server Security Agent 3.5.1163 Removal from Dell Laptops

OVERVIEW

Some Dell laptops came bundled with “Trend Micro Client/Server Security Agent” which most people will want to uninstall. I recently had to restore a Dell Latitude E6430 to the Factory Defaults. When removing the bundled bloatware, uninstalling “Trend Micro Client/Server Security Agent” froze up and I had to kill the process. Upon rebooting, it was still partially installed. However, when I tried uninstalling again, Trend Micro was prompting me for a password to uninstall it. Lots of searching kept leading me to Trend Micro removal tools that just flat out failed. I started to notice all the removal tools were for WFBS CSA 5.0+, WFBS SA 6.0+, Titanium 2011+, Diagnostic Toolkit, etc…. I looked in Windows Programs and Features and noticed the Trend Micro Client/Server Security Agent Product Version: 3.5.1163 matched nothing I could find on Trend Micro’s website. After hours of digging, I found a sure fire way to remove this program. I’ll list some of the “common” solutions below and finish with my guaranteed procedure.

Trend Micro Client/Server Security Agent 3.5.1163

REMOVAL METHOD 1

Uninstalling the Worry-Free Business Security (WFBS) Agent using the Uninstall Tool

Download the uninstall tool direct from Trend Micro OR direct from sigkillit.com (In case they pull their copy down).
Run SA_Uninstall_1384.exe to extract the files
Locate Uninstall.bat and run
- If you have UAC enabled, right-click and select “Run as administrator”

REMOVAL METHOD 2

Open a command prompt
- If you have UAC enabled, make sure you run it as an elevated command prompt
At the command prompt change to one of the following directories depending if you have a 32-bit or 64-bit Operating System
- 32-bit: C:\Program Files\Trend Micro\Client Server Security Agent\
- 64-bit: C:\Program Files (x86)\Trend Micro\Client Server Security Agent\
Run the following command
- ntrmv -980223

REMOVAL METHOD 3

If you’re being prompted to supply a password to remove Trend Micro, the following registry edits will disable that prompt. After the prompt is disabled, you should be able to remove it through Programs and Features without having to supply the password:

Open the registry editor
- Click Start and in the search box enter: regedit
- Click regedit
Open the one of the following registry keys depending if you have a 32-bit or 64-bit Operating System
- 32-bit: HKEY_LOCAL_MACHINE\SOFTWARE\TrendMicro\PC-cillinNTCorp\CurrentVersion\Misc
- 64-bit: HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\TrendMicro\PC-cillinNTCorp\CurrentVersion\Misc
Locate the DWORD “Allow Uninstall” and change the Value from “0” to “1”
- If it does not exist, you’ll need to create it:
  - Click Edit->New->DWORD (32-bit) Value
  - Name: Allow Uninstall
  - Data: 1
Uninstall Trend Micro through Programs and Features and you should no longer get prompted for an uninstall password

REMOVAL METHOD 4 (GUARANTEED TO WORK WHEN EVERYTHING ELSE FAILS!!!)

This method uses a special uninstall tool that’s not publicly listed on Trend Micro’s website. The tool is not graceful, will throw prompts you need to dismiss, and you’ll probably need to manually close it out. With that being said, here’s what you need to do.

Download the uninstall tool direct from Trend Micro OR direct from sigkillit.com
Unzip the exe and when prompted for the password use
- Password: trend
Run WFBSS_UninstallTool_V1106.exe
- If you have UAC enabled, right-click and select “Run as administrator”
Accept the terms and click Next
Click Install
- Keep clicking Retry if prompted to continue the installation. This will occur multiple times (5 in my case), but keep going
The uninstaller will open several prompts including (Click to ignore any prompts you receive and continue)
- Multiple command prompts
- Multiple Trend Miro Uninstallation Tool progress windows
  - Wait for the progress bars to stop moving, which can take several minutes
After about 10 minutes, you should see no more progress on any of the windows
- Close all of the command prompt windows
- The “TrendMicro Uninstallation Tool – Setup” window should now show “Installation Successful”
- Reboot the computer
- Check in Programs and Features and the Trend Micro Client/Server Security Agent will be gone!

Apr 22

Run Active Directory Management Tools as Another User

Posted on April 22, 2014 by admin

There’s quite a few situations where you may need to run Active Directory Management tools like Active Directory Users and Computers with different credentials. For example:

Computer is not joined to the domain
Need to connect to another domain/forest
Logged in as a standard domain user and need to supply different credentials
etc…

Step 1 – Install Remote Server Administration Tools (RSAT)

If you are using a 2008 or 2012 WIndows member server, RSAT is a feature you must enable using the directions below:

RSAT Server 2008 or 2012

If you’re using Windows Vista, WIndows 7, Windows 8, or Windows 10 you must download, install, and enable the RSAT feature. Here are the links to download RSAT:

RSAT Windows 10 (By default all features are enabled)

Once you’ve installed RSAT you need to enable the feature (Except Windows 10). Open Control Panel, click Programs and Features, and click Turn Windows features on or off. Then enable the following:

Step 2 – Make Sure You’re on the Domain Network

Make sure you’re on the same network as the Domain Controller. This simply means, connect to the LAN they’re on, or connect to a VPN if you’re remote.

Step 3 – Run As Commands for AD Management Tools

The key to running AD Management tools is the Runas command in Windows, which allows you to specify alternate credentials. However, there are a few gotcha’s with runas such as needing to specify the /netonly command when on a non-domain computer. Here are the commands you’ll need to run to successfully launch the AD Management tools, and all will work whether or not the computer is joined to a domain:

C:\Windows\System32\runas.exe – Default path to runas
/netonly – Credentials are specified for remote access, which is required for computers not joined to a domain but still works if the computer is on the domain
/user: – specify the username by the samaccountname(DOMAIN\user) or UPN(user@domain.local)
“mmc %SystemRoot%\system32\snapin.msc” – Microsoft Management Console with the path to the snapin.

C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\adsiedit.msc"

1	C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\adsiedit.msc"

C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\domain.msc /server=pdc.domain.local"

1	C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\domain.msc /server=pdc.domain.local"

Note: I’ve added an extra parameter to specify the PDC Emulator, otherwise you may receive the error “You cannot modify domain or trust information because a Primary Domain Controller (PDC) emulator cannot be contacted.”

C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\dssite.msc /domain=domain.local"

1	C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\dssite.msc /domain=domain.local"

Note: I’ve added an extra parameter to specify the domain, otherwise you may receive the error “Naming information cannot be located because: The specified domain either does not exist or could not be contacted.”

C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\dsa.msc /domain=domain.local"

1	C:\Windows\System32\runas.exe /netonly /user:user@domain.local "mmc %SystemRoot%\system32\dsa.msc /domain=domain.local"

Step 4 – Applying Run As Commands

Option 1: Run from an Elevated Command prompt

Right-click the command prompt (cmd.exe), select Run as Administrator, and enter one of the runas commands in the previous section.

option 2: create shortcut and run as administrator

Right-click in the Windows file explorer, select New, click shortcut, for the location enter one of the runas commands from the previous section, click Next, name the shortcut appropriately, and click Finish. Whenever you launch the shortcut, right-click it and select Run as Administrator.

option 3: modify RSAT shortcuts

Under Administrative Tools on the start menu, right-click each RSAT shortcut, click Properties, and modify the target using the appropriate runas command from the previous section. Whenever you launch the shortcut, right-click it and select Run as Administrator.

Apr 04

Delivery Report in Outlook or Outlook Web App

Posted on April 4, 2014 by admin

Overview

When using Outlook or Outlook Web App (OWA) in an Office 365 or Exchange environment, you can track the message from the client side. Both Outlook and OWA allow you to view a delivery report in order to confirm a message was delivered when the recipient claims they have not received it or if it’s taking a long time to deliver. Delivery reports work for both internal and external recipients.

View a Delivery Report in Outlook

In Outlook, go to your Sent Items folder
Locate the message you want to track and open it
Click File, click Info, and click Open Delivery Report

View a Delivery Report in Outlook Web App (OWA)

If you are using any other email client than Outlook (mobile device, OWA, etc), you can use OWA to view a delivery report.

Login to OWA at https://portal.microsoftonline.com
Click the Gear Icon, then click Options
Click Organize Email then click Delivery Reports
Enter your search criteria, click Search
Select the email you want to track and click the Pencil Icon to view the delivery report

Review Delivery Report

Internal delivery reports will show Delivered upon success delivering. Also note, Office 365 Exchange only keeps message tracking data for 14 days.

External delivery reports will only show Transferred which means it successfully sent out from your mail server. However, this does not guarantee the recipient received the email because there can be issues on the recipients email server.

Mar 20

SyncToy21.vbs

Posted on March 20, 2014 by admin

'=========================================================================
' SyncToy21.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 3/20/20114
' REQUIREMENTS: You must install SyncToy on the Workstation and manually run it to click on
' the agreement statement, otherwise this script will lock up and NEVER back up!!!
'=========================================================================
Option Explicit

' ------ SCRIPT CONFIGURATION ------
Const strContact = "backup@domain.com"
Dim syncToyExe: syncToyExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToy.exe")
Dim syncToyExeX86: syncToyExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToy.exe")
Dim syncToyCmdExe: syncToyCmdExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToyCmd.exe")
Dim syncToyCmdExeX86: syncToyCmdExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToyCmd.exe")
Dim blnAutoRun: blnAutoRun = True
Dim syncOperation: syncOperation = "echo"
Dim strBackupPath: strBackupPath = ExpandEnv("\\server\backups\%USERNAME%\")
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
' ------ END CONFIGURATION ------

Call Main()

Private Sub Main()

    ' Create Objects
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Set Folders for Backups
    Dim strDocuments: strDocuments = objShell.SpecialFolders("MyDocuments")
    Dim strMusic: strMusic = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music")
    Dim strPictures: strPictures = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures")
    Dim strVideos: strVideos = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video")

    ' Ensure Backup Path Ends with Slash
    If Right(strBackupPath,1) <> "\" Then
        strBackupPath = strBackupPath & "\"
    End If

    ' Validate Folders for Backup
    Dim strResult: strResult = ""
    If Not objFSO.FolderExists(strDocuments) Then
        strResult = strResult & "- Missing Documents Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strMusic) Then
        strResult = strResult & "- Missing Music Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strPictures) Then
        strResult = strResult & "- Missing Pictures Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strBackupPath) Then
        strResult = strResult & "- Missing Backup Folder" & vbCrLf
    End If

    ' Validate SyncToy Path
    If Not objFSO.FileExists(syncToyExe) Then
        If Not objFSO.FileExists(syncToyExeX86) Then
            strResult = strResult & "- Missing SyncToy.exe" & vbCrLf
        Else
            syncToyExe = syncToyExeX86
        End If
    End If
    If Not objFSO.FileExists(syncToyCmdExe) Then
        If Not objFSO.FileExists(syncToyCmdExeX86) Then
            strResult = strResult & "- Missing SyncToyCmd.exe" & vbCrLf
        Else
            syncToyCmdExe = syncToyCmdExeX86
        End If
    End If

    ' Ensure Everything Validated
    If strResult <> "" Then
        objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _
            strResult & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical
        Wscript.Quit
    End If

    ' Determine Which Folders To Backup and Prompt to Backup
    Dim intAnswer
    Dim blnDocuments: blnDocuments = True
    Dim blnMusic: blnMusic = False
    Dim blnPictures: blnPictures = False
    Dim blnVideos: blnVideos = False
    If InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
    Elseif InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
         Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strPictures,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
    Else
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    End If

    'Validate Backup Folder Exists Or Try to Create Them
    strResult = ""
    If blnDocuments = True Then
        If ValidateFolder(strBackupPath & "Documents") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Documents" & vbCrLf
        End If
    End If
    If blnMusic = True Then
        If ValidateFolder(strBackupPath & "Music") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Music" & vbCrLf
        End If 
    End If
    If blnPictures = True Then
        If ValidateFolder(strBackupPath & "Pictures") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Pictures" & vbCrLf
        End If
    End If
    If blnVideos = True Then
        If ValidateFolder(strBackupPath & "Videos") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Videos" & vbCrLf
        End If
    End If

    ' Ensure Everything Validated
    If strResult <> "" Then
        objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _
            strResult & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical
        Wscript.Quit
    End If

    ' Create Folder Pairs
    Call CreateSyncToyPairs(blnDocuments, strDocuments, blnMusic, strMusic, blnPictures, strPictures, blnVideos, strVideos)

    ' Run SyncToy Backup
    If blnDocuments = True Then
        Call RunSyncToy("Documents")
    End If
    If blnMusic = True Then
        Call RunSyncToy("Music")
    End If
    If blnPictures = True Then
        Call RunSyncToy("Pictures")
    End If
    If blnVideos = True Then
        Call RunSyncToy("Videos")
    End If

    ' Cleanup
    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Function ValidateFolder(ByVal strFolder)

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim blnResult: blnResult = True
    On Error Resume Next
    If Not objFSO.FolderExists(strFolder) Then
        objFSO.CreateFolder(strFolder)
    End If
    If Err.Number <> 0 Then
        Err.Clear
        blnResult = False
    End If
    On Error Goto 0

    ValidateFolder = blnResult

End Function

Private Sub CreateSyncToyPairs(ByVal bDoc, ByVal sDoc, ByVal bMus, ByVal sMus, ByVal bPic, ByVal sPic, ByVal bVid, ByVal sVid)

    ' Create Objects
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Attempt to Delete Folder Pairs
    Call DeleteSyncToyPair(sDoc,"Documents")
    Call DeleteSyncToyPair(sMus,"Music")
    Call deleteSyncToyPair(sPic,"Pictures")
    Call deleteSyncToyPair(sVid,"Videos")

    ' Create Folder Pairs
    If bDoc = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sDoc & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Documents" & chr(34) & _
        ",name=Documents" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true  
    End If
    If bMus = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sMus & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Music" & chr(34) & _
        ",name=Music" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If
    If bPic = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sPic & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Pictures" & chr(34) & _
        ",name=Pictures" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If
    If bVid = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sVid & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Videos" & chr(34) & _
        ",name=Videos" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If

    Set objShell = Nothing

End Sub

Private Sub DeleteSyncToyPair(ByVal strPath, ByVal strPair)

    ' Detect if a Config File Exists in the leftFolder and try to Delete Folder Pair
    ' This will ensure all Left Folder Files Write to the Right Folder and Will Skip
    ' Duplicates.  Otherwise Files on the left will not write to the right if they are
    ' deleted from the right
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )
    Dim colFiles: Set colFiles = objFSO.GetFolder(strPath).Files
    Dim File, strErr
    For Each File in colFiles
        If InStr(1,File.Name,"SyncToy",1) > 0 AND StrComp(objFSO.GetExtensionName(File.Name),"dat",1) = 0 Then
            'SyncToy File Exists, Try to Delete Pair
            Call KillProcess("SyncToy.exe") 'Terminate SyncToy Processes Else a Delete Fails
            Call KillProcess("SyncToyCmd.exe")
            strErr = objShell.Run(chr(34) & syncToyExe & Chr(34) & " -u" & strPair, 0, false)
            'Cheap hack if it errors because the pair doesnt exist to kill the window
            Wscript.Sleep 10000
            Call KillProcess("SyncToy.exe")
            Call KillProcess("SyncToyCmd.exe")
        End If
    Next

    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Sub RunSyncToy(ByVal folderPair)

    ' Create Objects
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Run SyncToy as Manual or Automated
    If blnAutoRun = False Then
        objShell.Run chr(34) & syncToyExe & chr(34)
    Else
        ' Set Path to SyncToyLog and Clear Log
        Dim syncToyLog: syncToyLog = ExpandEnv("%LOCALAPPDATA%\Microsoft\SyncToy\2.0\SyncToyLog.log")
        If InStr(1,syncToyLog,"%",1) > 0 Then
            syncToyLog = ExpandEnv("%USERPROFILE%\Local Settings\Application Data\Microsoft\SyncToy\2.0\SyncToyLog.log")
        End If
        If InStr(1,syncToyLog,"%",1) > 0 Then
            syncToyLog = "!~ERROR~!"
        End If
        If objFSO.FileExists(syncToyLog) Then
            Call Logger(syncToyLog, "", True)
        End If 

        ' Run Automated SyncToy Backup
        objShell.Run chr(34) & syncToyCmdExe & Chr(34) & " -R " & chr(34) & folderPair & chr(34), 1, true

        ' Parse SyncToyLog to Ensure It Successfully Ran
        Dim strError: strError = ""
        If objFSO.FileExists(syncToyLog) Then
            strError = ParseSyncToyLog(syncToyLog)
            If strError <> "" Then
                ' Error Detected in Sync
                objShell.Popup "An ERROR occurred backing up folder pair: " & folderPair & vbCrLf & _
                strError & vbCrLf & _
                "Please contact " & strContact _
                , 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical
            End If
        Else
            ' Error Getting Log to Parse
            objShell.Popup "An ERROR occurred obtaining log file to check for errors after backing up folder pair: " & folderPair & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical
        End If

        'Copy SyncToy Log to Backup Path
        If objFSO.FIleExists(syncToyLog) Then
            objFSO.CopyFile syncToyLog, strBackupPath, True
        End If
    End If

    ' Cleanup
    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Function ParseSyncToyLog(ByVal strLog)

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Const ForReading = 1
    Dim objFile: Set objFile = objFSO.OpenTextFile(strLog, ForReading)
    Dim strLine
    Dim strResult: strResult = ""
    Dim blnAction: blnAction = True
    Dim blnWarning: blnWarning = False
    Dim blnError: blnError = False
    Do Until objFile.AtEndOfStream
        strLine = objFile.ReadLine
        If Len(strLine) > 0 Then
            ' Backup SyncToyLog for Archiving
            Call Logger(Replace(strLog,"SyncToyLog.log","SyncToyLog_Full.txt",1,1,1),strLine,False)

            ' Check If Actions Were Performed
            If InStr(1,strLine,"Found 0 actions to perform",1) > 0 Then
                blnAction = False
            End If

            ' Check If Warning Was Logged
            If InStr(1,strLine,"Warning:",1) > 0 Then
                blnWarning = True
                If strResult = "" Then
                    strResult = strLine
                Else
                    strResult = strResult & vbcrlf & strLine
                End If
            End If

            ' Check If Error Was Logged
            If InStr(1,strLine,"Error:",1) > 0 Then
                blnError = True
                If strResult = "" Then
                    strResult = strLine
                Else
                    strResult = strResult & vbcrlf & strLine
                End If
            End If
        End If
    Loop
    objFile.Close

    Set objFSO = Nothing

    ParseSyncToyLog = strResult

End Function

Private Sub KillProcess(ByVal strProcess)
    Dim strComputer: strComputer = "."
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
    Dim objItem
    For Each objItem in colItems
        If StrComp(objItem.Name, strProcess, 1) = 0 Then
            objItem.Terminate()
        End If
    Next
End Sub

Private Function ExpandEnv(ByVal strPath)

    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )
    ExpandEnv = objShell.ExpandEnvironmentStrings(strPath)
    Set objShell = Nothing

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

'=========================================================================

' SyncToy21.vbs

' VERSION: 1.0

' AUTHOR: Brian Steinmeyer

' EMAIL: sigkill@sigkillit.com

' WEB: http://sigkillit.com

' DATE: 3/20/20114

' REQUIREMENTS: You must install SyncToy on the Workstation and manually run it to click on

' the agreement statement, otherwise this script will lock up and NEVER back up!!!

'=========================================================================

Option Explicit

' ------ SCRIPT CONFIGURATION ------

Const strContact = "backup@domain.com"

Dim syncToyExe: syncToyExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToy.exe")

Dim syncToyExeX86: syncToyExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToy.exe")

Dim syncToyCmdExe: syncToyCmdExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToyCmd.exe")

Dim syncToyCmdExeX86: syncToyCmdExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToyCmd.exe")

Dim blnAutoRun: blnAutoRun = True

Dim syncOperation: syncOperation = "echo"

Dim strBackupPath: strBackupPath = ExpandEnv("\\server\backups\%USERNAME%\")

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

' ------ END CONFIGURATION ------

Call Main()

Private Sub Main()

' Create Objects

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

' Set Folders for Backups

Dim strDocuments: strDocuments = objShell.SpecialFolders("MyDocuments")

Dim strMusic: strMusic = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music")

Dim strPictures: strPictures = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures")

Dim strVideos: strVideos = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video")

' Ensure Backup Path Ends with Slash

If Right(strBackupPath,1) <> "\" Then

strBackupPath = strBackupPath & "\"

End If

' Validate Folders for Backup

Dim strResult: strResult = ""

If Not objFSO.FolderExists(strDocuments) Then

strResult = strResult & "- Missing Documents Folder" & vbCrLf

End If

If Not objFSO.FolderExists(strMusic) Then

strResult = strResult & "- Missing Music Folder" & vbCrLf

End If

If Not objFSO.FolderExists(strPictures) Then

strResult = strResult & "- Missing Pictures Folder" & vbCrLf

End If

If Not objFSO.FolderExists(strBackupPath) Then

strResult = strResult & "- Missing Backup Folder" & vbCrLf

End If

' Validate SyncToy Path

If Not objFSO.FileExists(syncToyExe) Then

If Not objFSO.FileExists(syncToyExeX86) Then

strResult = strResult & "- Missing SyncToy.exe" & vbCrLf

Else

syncToyExe = syncToyExeX86

End If

If Not objFSO.FileExists(syncToyCmdExe) Then

If Not objFSO.FileExists(syncToyCmdExeX86) Then

strResult = strResult & "- Missing SyncToyCmd.exe" & vbCrLf

Else

syncToyCmdExe = syncToyCmdExeX86

End If

' Ensure Everything Validated

If strResult <> "" Then

objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _

strResult & vbCrLf & _

"Please contact " & strContact _

, 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical

Wscript.Quit

End If

' Determine Which Folders To Backup and Prompt to Backup

Dim intAnswer

Dim blnDocuments: blnDocuments = True

Dim blnMusic: blnMusic = False

Dim blnPictures: blnPictures = False

Dim blnVideos: blnVideos = False

If InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Videos

intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnVideos = False

End If

Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Pictures

intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnPictures = False

End If

Elseif InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Music

intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnMusic = False

End If

Elseif InStr(1,strMusic,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Pictures

intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnPictures = False

End If

Backup Videos

intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnVideos = False

End If

Elseif InStr(1,strPictures,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Music

intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnMusic = False

End If

' Backup Videos

intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnVideos = False

End If

Elseif InStr(1,strVideos,strDocuments,1) > 0 Then

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Music

intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnMusic = False

End If

' Backup Pictures

intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnPictures = False

End If

Else

' Backup Documents

intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnDocuments = False

End If

' Backup Music

intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnMusic = False

End If

' Backup Pictures

intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnPictures = False

End If

' Backup Videos

intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)

If intAnswer = vbNo Then

blnVideos = False

End If

'Validate Backup Folder Exists Or Try to Create Them

strResult = ""

If blnDocuments = True Then

If ValidateFolder(strBackupPath & "Documents") = False Then

strResult = strResult & "- Missing " & strBackupPath & "Documents" & vbCrLf

End If

If blnMusic = True Then

If ValidateFolder(strBackupPath & "Music") = False Then

strResult = strResult & "- Missing " & strBackupPath & "Music" & vbCrLf

End If

If blnPictures = True Then

If ValidateFolder(strBackupPath & "Pictures") = False Then

strResult = strResult & "- Missing " & strBackupPath & "Pictures" & vbCrLf

End If

If blnVideos = True Then

If ValidateFolder(strBackupPath & "Videos") = False Then

strResult = strResult & "- Missing " & strBackupPath & "Videos" & vbCrLf

End If

' Ensure Everything Validated

If strResult <> "" Then

objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _

strResult & vbCrLf & _

"Please contact " & strContact _

, 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical

Wscript.Quit

End If

' Create Folder Pairs

Call CreateSyncToyPairs(blnDocuments, strDocuments, blnMusic, strMusic, blnPictures, strPictures, blnVideos, strVideos)

' Run SyncToy Backup

If blnDocuments = True Then

Call RunSyncToy("Documents")

End If

If blnMusic = True Then

Call RunSyncToy("Music")

End If

If blnPictures = True Then

Call RunSyncToy("Pictures")

End If

If blnVideos = True Then

Call RunSyncToy("Videos")

End If

' Cleanup

Set objFSO = Nothing

Set objShell = Nothing

End Sub

Private Function ValidateFolder(ByVal strFolder)

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim blnResult: blnResult = True

On Error Resume Next

If Not objFSO.FolderExists(strFolder) Then

objFSO.CreateFolder(strFolder)

End If

If Err.Number <> 0 Then

Err.Clear

blnResult = False

End If

On Error Goto 0

ValidateFolder = blnResult

End Function

Private Sub CreateSyncToyPairs(ByVal bDoc, ByVal sDoc, ByVal bMus, ByVal sMus, ByVal bPic, ByVal sPic, ByVal bVid, ByVal sVid)

' Create Objects

Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

' Attempt to Delete Folder Pairs

Call DeleteSyncToyPair(sDoc,"Documents")

Call DeleteSyncToyPair(sMus,"Music")

Call deleteSyncToyPair(sPic,"Pictures")

Call deleteSyncToyPair(sVid,"Videos")

' Create Folder Pairs

If bDoc = True Then

objShell.Run chr(34) & syncToyExe & Chr(34) & _

" -d(left=" & chr(34) & sDoc & chr(34) & _

",right=" & chr(34) & strBackupPath & "Documents" & chr(34) & _

",name=Documents" & _

",operation=" & syncOperation & _

",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true

End If

If bMus = True Then

objShell.Run chr(34) & syncToyExe & Chr(34) & _

" -d(left=" & chr(34) & sMus & chr(34) & _

",right=" & chr(34) & strBackupPath & "Music" & chr(34) & _

",name=Music" & _

",operation=" & syncOperation & _

",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true

End If

If bPic = True Then

objShell.Run chr(34) & syncToyExe & Chr(34) & _

" -d(left=" & chr(34) & sPic & chr(34) & _

",right=" & chr(34) & strBackupPath & "Pictures" & chr(34) & _

",name=Pictures" & _

",operation=" & syncOperation & _

",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true

End If

If bVid = True Then

objShell.Run chr(34) & syncToyExe & Chr(34) & _

" -d(left=" & chr(34) & sVid & chr(34) & _

",right=" & chr(34) & strBackupPath & "Videos" & chr(34) & _

",name=Videos" & _

",operation=" & syncOperation & _

",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true

End If

Set objShell = Nothing

End Sub

Private Sub DeleteSyncToyPair(ByVal strPath, ByVal strPair)

' Detect if a Config File Exists in the leftFolder and try to Delete Folder Pair

' This will ensure all Left Folder Files Write to the Right Folder and Will Skip

' Duplicates. Otherwise Files on the left will not write to the right if they are

' deleted from the right

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

Dim colFiles: Set colFiles = objFSO.GetFolder(strPath).Files

Dim File, strErr

For Each File in colFiles

If InStr(1,File.Name,"SyncToy",1) > 0 AND StrComp(objFSO.GetExtensionName(File.Name),"dat",1) = 0 Then

'SyncToy File Exists, Try to Delete Pair

Call KillProcess("SyncToy.exe") 'Terminate SyncToy Processes Else a Delete Fails

Call KillProcess("SyncToyCmd.exe")

strErr = objShell.Run(chr(34) & syncToyExe & Chr(34) & " -u" & strPair, 0, false)

'Cheap hack if it errors because the pair doesnt exist to kill the window

Wscript.Sleep 10000

Call KillProcess("SyncToy.exe")

Call KillProcess("SyncToyCmd.exe")

End If

Set objFSO = Nothing

Set objShell = Nothing

End Sub

Private Sub RunSyncToy(ByVal folderPair)

' Create Objects

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

' Run SyncToy as Manual or Automated

If blnAutoRun = False Then

objShell.Run chr(34) & syncToyExe & chr(34)

Else

' Set Path to SyncToyLog and Clear Log

Dim syncToyLog: syncToyLog = ExpandEnv("%LOCALAPPDATA%\Microsoft\SyncToy\2.0\SyncToyLog.log")

If InStr(1,syncToyLog,"%",1) > 0 Then

syncToyLog = ExpandEnv("%USERPROFILE%\Local Settings\Application Data\Microsoft\SyncToy\2.0\SyncToyLog.log")

End If

If InStr(1,syncToyLog,"%",1) > 0 Then

syncToyLog = "!~ERROR~!"

End If

If objFSO.FileExists(syncToyLog) Then

Call Logger(syncToyLog, "", True)

End If

' Run Automated SyncToy Backup

objShell.Run chr(34) & syncToyCmdExe & Chr(34) & " -R " & chr(34) & folderPair & chr(34), 1, true

' Parse SyncToyLog to Ensure It Successfully Ran

Dim strError: strError = ""

If objFSO.FileExists(syncToyLog) Then

strError = ParseSyncToyLog(syncToyLog)

If strError <> "" Then

' Error Detected in Sync

objShell.Popup "An ERROR occurred backing up folder pair: " & folderPair & vbCrLf & _

strError & vbCrLf & _

"Please contact " & strContact _

, 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical

End If

Else

' Error Getting Log to Parse

objShell.Popup "An ERROR occurred obtaining log file to check for errors after backing up folder pair: " & folderPair & vbCrLf & _

"Please contact " & strContact _

, 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical

End If

'Copy SyncToy Log to Backup Path

If objFSO.FIleExists(syncToyLog) Then

objFSO.CopyFile syncToyLog, strBackupPath, True

End If

' Cleanup

Set objFSO = Nothing

Set objShell = Nothing

End Sub

Private Function ParseSyncToyLog(ByVal strLog)

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Const ForReading = 1

Dim objFile: Set objFile = objFSO.OpenTextFile(strLog, ForReading)

Dim strLine

Dim strResult: strResult = ""

Dim blnAction: blnAction = True

Dim blnWarning: blnWarning = False

Dim blnError: blnError = False

Do Until objFile.AtEndOfStream

strLine = objFile.ReadLine

If Len(strLine) > 0 Then

' Backup SyncToyLog for Archiving

Call Logger(Replace(strLog,"SyncToyLog.log","SyncToyLog_Full.txt",1,1,1),strLine,False)

' Check If Actions Were Performed

If InStr(1,strLine,"Found 0 actions to perform",1) > 0 Then

blnAction = False

End If

' Check If Warning Was Logged

If InStr(1,strLine,"Warning:",1) > 0 Then

blnWarning = True

If strResult = "" Then

strResult = strLine

Else

strResult = strResult & vbcrlf & strLine

End If

' Check If Error Was Logged

If InStr(1,strLine,"Error:",1) > 0 Then

blnError = True

If strResult = "" Then

strResult = strLine

Else

strResult = strResult & vbcrlf & strLine

End If

Loop

objFile.Close

Set objFSO = Nothing

ParseSyncToyLog = strResult

End Function

Private Sub KillProcess(ByVal strProcess)

Dim strComputer: strComputer = "."

Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Dim colItems: Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")

Dim objItem

For Each objItem in colItems

If StrComp(objItem.Name, strProcess, 1) = 0 Then

objItem.Terminate()

End If

End Sub

Private Function ExpandEnv(ByVal strPath)

Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

ExpandEnv = objShell.ExpandEnvironmentStrings(strPath)

Set objShell = Nothing

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

Dim logName

If InStr(1,fileName,"\",1) > 0 Then

logName = fileName

If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then

If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then

If Not objFSO.FolderExists(logName) Then

If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then

objFSO.CreateFolder logName 'Create Folder In Current Path

Exit Sub

Else

Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder

Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder

Exit Sub

End If

Else

If Not objFSO.FileExists(logName) Then

If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then

Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder

Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder

End If

Else

logName = scriptPath & fileName

End If

Dim logFile

If blnNewLog = True Then

Set logFile = objFSO.CreateTextFile(logName, True)

Else

If objFSO.FileExists(logName) Then

Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)

Else

Set logFile = objFSO.CreateTextFile(logName, True)

End If

logFile.WriteLine logMessage

logFile.Close

Set objFSO = Nothing

End Sub

Feb 07

Outlook unable to open your default e-mail folders

Posted on February 7, 2013 by admin

Error Messages

unable to open your default e-mail folders
Cannot open the Outlook window. The server is not available.

Resolution 1

Outlook was installed with compatibility mode.

Locate your outlook.exe,
1. Typically in C:\Program Files (x86)\Microsoft Office\Office14\
  1. (Note: 14 is for office 2010, yours may vary depending on your version of Outlook).
Right-click the OUTLOOK.EXE, and select properties.
On the Compatibility tab, uncheck all of the settings as shown below

Resolution 2

Use the /resetnavpane when opening Outlook.

Click Start and enter cmd in the search/run menu to open a command prompt
In the command prompt, run the following command
1. (Note: 14 is for office 2010, yours may vary depending on your version of Outlook)

C:\Program Files (x86)\Microsoft Office\Office14\outlook.exe /resetnavpane

1	C:\Program Files (x86)\Microsoft Office\Office14\outlook.exe /resetnavpane

Jan 26

Running VBScripts with UAC Elevation

Posted on January 26, 2013 by admin

Overview

Since the introduction of User Account Control (UAC), scripts do not run with administrator privileges despite being a local administrator. You must elevate your script to run with administrator privileges. I’ll start by showing you a simple example. The script below will list all of the processes on the local computer as well as the WIN32_Process CommandLine property. If you run the script on a computer with UAC without elevating it, you will only see CommandLine values for processes created by your account; if any other processes were created by another account, the CommandLine property will be NULL.

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process",,48)
For Each objItem in colItems
Wscript.Echo "Process: " & objItem.Name & vbCrLf & _
"Startup: " & objItem.CommandLine
Next

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process",,48)

For Each objItem in colItems

Wscript.Echo "Process: " & objItem.Name & vbCrLf & _

"Startup: " & objItem.CommandLine

On a test machine, I was logged on as User1, opened notepad, and launched a vbscript as the local administrator account using RunAs. I ran the script above and compared the results to task manager with the following results:

As you can see, the script successfully showed the CommandLine property for the currently logged on user

However, the test script failed to show the CommandLine property for the wscript.exe process running as administrator:

By re-running the test script with elevated privileges, the script now successfully shows the CommandLine property for the wscript process running as Administrator.

Now that I have successfully demonstrated the need to run a script elevated on a local machine, you might be wondering what happens when you the test script on a remote machine. If you run the script on a remote machine that you have administrator rights on, it will successfully display the CommandLine property for all users. Now, you might be confused as to why it works remotely? The answer is quite simple, the script is elevated by RPC. Now that you have a good understanding of running vbscripts with UAC elevation, here are some methods on how to elevate them.

Method 1 – Elevating Using the Command Prompt

Click Start, All Programs, Click Accessories
Right-click Command Prompt and click Run as administrator
Click Yes
Any script you launch using wscript.exe or cscript.exe will launch elevated

Method 2 – RunAs Script

This method uses a wrapper script to run an elevated VBScript using the runas verb with the ShellExecute method of Shell.Application. When it launches the elevated script, click Yes

http://sigkillit.com/2013/01/25/elevatewscript-vbs/

Method 3 – Add ‘Run as administrator’ to the .vbs File Context Menu

The ‘Run as administrator’ option on a File Context Menu is only available on certain file types by default, and .vbs files are not one of them. However, by doing a quick registry modification we can enable the ‘Run as administrator’ option o the file context menu. Download and run the following registry to merge it into your registry, or you can copy the below text and save it to a .reg file:

Add Run as administrator to VBS File Context Menu

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas]
"HasLUAShield"=""

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas\Command]
@=hex(2):22,00,25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,6f,00,74,\
00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,57,00,\
53,00,63,00,72,00,69,00,70,00,74,00,2e,00,65,00,78,00,65,00,22,00,20,00,22,\
00,25,00,31,00,22,00,20,00,25,00,2a,00,00,00

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas]

"HasLUAShield"=""

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas\Command]

@=hex(2):22,00,25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,6f,00,74,\

00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,57,00,\

53,00,63,00,72,00,69,00,70,00,74,00,2e,00,65,00,78,00,65,00,22,00,20,00,22,\

00,25,00,31,00,22,00,20,00,25,00,2a,00,00,00

Page 1 of 212

Sigkill IT

Code and IT Knowledge

Category Archives: Windows

Remove RDS CALs from RDS Server

Rebuild the RD Licensing Database

Missing Power and Search Button On Start Screen

Move Off-Screen Window in Windows

Mail Merge with Attachment

Step 1 – Create Data Source

Step 2 – Create Outlook Profile to Send Mail Merge From

Step 3 – Create Powershell Script

In addition to modifying the above variables, you’ll need to modify $Mail.Body, which is the body of the email. The below example is referencing data fields in users.csv for the mail merge, which you may want to modify. These correspond as follows:

Step 4 – Send the Mail Merge

Removing Trend Micro Client/Server Security Agent from Dell Laptops

Trend Micro Client/Server Security Agent 3.5.1163 Removal from Dell Laptops

Run Active Directory Management Tools as Another User

Step 1 – Install Remote Server Administration Tools (RSAT)

Step 2 – Make Sure You’re on the Domain Network

Step 3 – Run As Commands for AD Management Tools

Step 4 – Applying Run As Commands

Option 1: Run from an Elevated Command prompt

option 2: create shortcut and run as administrator

option 3: modify RSAT shortcuts

Delivery Report in Outlook or Outlook Web App

Overview

View a Delivery Report in Outlook

View a Delivery Report in Outlook Web App (OWA)

Review Delivery Report

SyncToy21.vbs

Outlook unable to open your default e-mail folders

Error Messages

Resolution 1

Resolution 2

Running VBScripts with UAC Elevation

Overview

Method 1 – Elevating Using the Command Prompt

Method 2 – RunAs Script

Method 3 – Add ‘Run as administrator’ to the .vbs File Context Menu