Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Sample: Copy files and invoking CD Writing in XP

82 views
Skip to first unread message

John Smith

unread,
Feb 19, 2002, 11:16:13 PM2/19/02
to
Option Explicit

Dim MyCDRW, MySource, MyCDNAME, MyDateCode, MyTarget

Dim oShell, oApp, oFolder, vbShort

' Change these three settings to suit your system
=====================================

MyCDRW = "E:\"

MySource = "C:\Documents and Settings\John\My Documents" 'Folder name only

MyCDName = "MyDocs" 'Keep this short (6 Chars) as we add a YYMMDD to the end

' Do not modify anything below this line
==============================================

Set oShell = WScript.CreateObject("WScript.Shell") 'Create As Object

Set oApp = CreateObject("Shell.Application") 'Create As Object

MyTarget =
oShell.regread("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shel
l Folders\CD Burning")


Set oFolder = oApp.Namespace(MySource) 'Create As Object

oApp.Namespace(MyTarget).CopyHere oFolder.Items 'Copy the files that are in
the source folder

oApp.NameSpace(&H11).ParseName(MyCDRW).InvokeVerbEx "Write &these files To
CD" 'Kick off the wizard

Do until oShell.appactivate("CD Writing Wizard") 'Wait for Dialog to Appears

wscript.sleep 500

Loop

MyDateCode = mid(formatDateTime(Date, vbshort),9,2) &
mid(formatDateTime(Date, vbshort),4,2) & left(formatDateTime(Date,
vbshort),2)

oShell.appactivate("CD Writing Wizard") 'Make sure it's the current window

oShell.SendKeys MyCDName & " " & MyDateCode 'Type in our CD Name

oShell.appactivate("CD Writing Wizard") 'Make sure it's the current window

oShell.SendKeys "{Enter}" 'Continue wizard

Do until Not oShell.appactivate("CD Writing Wizard") 'Keep script running
until Dialog is gone,

wscript.sleep 500 ' or else the wizard will close

Loop

Set oApp = Nothing

Set oFolder = Nothing

Set oShell = Nothing

0 new messages