We help IT Professionals succeed at work.

remove error

Indarnav
Indarnav used Ask the Experts™
on
below code is not copying data from cd drive to specified folder.giving error in 93. Invalid procedure call or argument

pls help
'basic declarations
Const BIF_returnonlyfsdirs   = &H0001
Const BIF_dontgobelowdomain  = &H0002
Const BIF_statustext         = &H0004
Const BIF_returnfsancestors  = &H0008
Const BIF_editbox            = &H0010
Const BIF_validate           = &H0020
Const BIF_browseforcomputer  = &H1000
Const BIF_browseforprinter   = &H2000
Const BIF_browseincludesSourcePaths = &H4000
Dim drv,ssp,CDDrive,sDestinationPath, objFile
Dim fso, fld,homefolder 
 
 
 
setfol()
 
 
Sub setfol()
strComputer="."
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive",,48)
 
For Each objItem In colItems
  colDrives = colDrives & "" & Replace(UCase(objItem.Drive), ":", "")
Next
MsgBox ("Your CD/DVD Drive letter is ")& colDrives & " " & "," & " " &("Please type it."),vbInformation,"CD/DVD Drive Letter"
Valid=False
 
Do
  strDrive = InputBox("Please Type Drive Letter for CD/DVD as displayed", "Select CD/DVD Drive", Strdrive)
  If Instr(colDrives, UCase(strDrive)) > 0 Then Valid=True
  If Trim(strdrive) = "" Then WScript.Quit 
  Loop Until Valid=True
MsgBox "Thanks for Typing Correct Alphabet " & strDrive,vbInformation,"Correct Drive"
 
 
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
homefolder = sDestinationPath
 
       ssp = Strdrive & ":\data"    '(\*.* to copy all)
 
 'calling folder selection function
  setdesti()
 
 'remove read only tag from destination folder.
 
NotReadOnly(HomeFolder)
 
 
  'select destination folder
 'copying code
Ofso.CopyFolder ssp,sDestinationPath,True 
Set fso = Nothing
 
End Sub
 
 
'2: selection for destination folder
sub setdesti()
 sDestinationPath = BrowseForFolder( _
        "Select a sDestinationPath or folder to copy", _
        BIF_returnonlyfsdirs , _
        "")
end sub
 
'3:browse folder function
 
Function BrowseForFolder(title, flag, dir)
    On Error Resume Next
    Dim oShell, oItem, tmp
    ' Create WshShell object.
    Set oShell = WScript.CreateObject("Shell.Application")
    ' Invoke Browse For Folder dialog box.
    Set oItem = oShell.BrowseForFolder(&H0, "Select Destination Folder/Folder ", flag, dir)
    ' Now we try to retrieve the full path.
    BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
    Set oShell = Nothing
    Set oItem = Nothing
    On Error GoTo 0
    End Function
    
    
'5: code for folder name
 
Sub NotReadOnly(FolderName)
 
    Dim fld, fil, sf
 
    Set fld = fso.GetFolder(FolderName)
    For Each fil In fld.Files
        fil.Attributes = 0
    Next
    For Each sf In fld.SubFolders
        NotReadOnly sf.Path
    Next
 
    Set fil = Nothing
    Set sf = Nothing
    Set fld = Nothing
 
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2014

Commented:
Try this.  If it doesn't work, can you please post the full error message, including line number.

Rob.
'basic declarations
Const BIF_returnonlyfsdirs   = &H0001
Const BIF_dontgobelowdomain  = &H0002
Const BIF_statustext         = &H0004
Const BIF_returnfsancestors  = &H0008
Const BIF_editbox            = &H0010
Const BIF_validate           = &H0020
Const BIF_browseforcomputer  = &H1000
Const BIF_browseforprinter   = &H2000
Const BIF_browseincludesSourcePaths = &H4000
Dim drv,ssp,CDDrive,sDestinationPath, objFile
Dim fso, fld,homefolder 
 
 
 
setfol()
 
 
Sub setfol()
strComputer="."
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive",,48)
 
For Each objItem In colItems
  colDrives = colDrives & "" & Replace(UCase(objItem.Drive), ":", "")
Next
MsgBox ("Your CD/DVD Drive letter is ")& colDrives & " " & "," & " " &("Please type it."),vbInformation,"CD/DVD Drive Letter"
Valid=False
 
Do
  strDrive = InputBox("Please Type Drive Letter for CD/DVD as displayed", "Select CD/DVD Drive", Strdrive)
  If Instr(colDrives, UCase(strDrive)) > 0 Then Valid=True
  If Trim(strdrive) = "" Then WScript.Quit 
  Loop Until Valid=True
MsgBox "Thanks for Typing Correct Alphabet " & strDrive,vbInformation,"Correct Drive"
 
 
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
ssp = Strdrive & ":\data"    '(\*.* to copy all)
 
'calling folder selection function
setdesti()
 
 'remove read only tag from destination folder.
homefolder = sDestinationPath 
NotReadOnly(HomeFolder)
 
 
  'select destination folder
 'copying code
Ofso.CopyFolder ssp,sDestinationPath,True 
Set fso = Nothing
 
End Sub
 
 
'2: selection for destination folder
sub setdesti()
 sDestinationPath = BrowseForFolder( _
        "Select a sDestinationPath or folder to copy", _
        BIF_returnonlyfsdirs , _
        "")
end sub
 
'3:browse folder function
 
Function BrowseForFolder(title, flag, dir)
    On Error Resume Next
    Dim oShell, oItem, tmp
    ' Create WshShell object.
    Set oShell = WScript.CreateObject("Shell.Application")
    ' Invoke Browse For Folder dialog box.
    Set oItem = oShell.BrowseForFolder(&H0, "Select Destination Folder/Folder ", flag, dir)
    ' Now we try to retrieve the full path.
    BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
    Set oShell = Nothing
    Set oItem = Nothing
    On Error GoTo 0
    End Function
    
    
'5: code for folder name
 
Sub NotReadOnly(FolderName)
 
    Dim fld, fil, sf
 
    Set fld = fso.GetFolder(FolderName)
    For Each fil In fld.Files
        fil.Attributes = 0
    Next
    For Each sf In fld.SubFolders
        NotReadOnly sf.Path
    Next
 
    Set fil = Nothing
    Set sf = Nothing
    Set fld = Nothing
 
End Sub

Open in new window

Author

Commented:
it is working fine. where u made changes and what?
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi, I just swapped a few lines around a bit.  I changed this section:

homefolder = sDestinationPath
 
       ssp = Strdrive & ":\data"    '(\*.* to copy all)
 
 'calling folder selection function
  setdesti()
 
 'remove read only tag from destination folder.
 
NotReadOnly(HomeFolder)



to this


ssp = Strdrive & ":\data"    '(\*.* to copy all)
 
'calling folder selection function
setdesti()
 
 'remove read only tag from destination folder.
homefolder = sDestinationPath
NotReadOnly(HomeFolder)



The problem was only that, in your original code, this line
homefolder = sDestinationPath

was before this line
setdesti()

and the setdesti() function actually sets the value of sDestinationPath, so setdesti() needs to be *before*
homefolder = sDestinationPath

so that homefolder will hold a proper value after the setdesti() call.

Regards,

Rob.

Author

Commented:
thank a lot.

Author

Commented:
one more guidance required.

in above code as your rectified, there are two points where user can try to exit from code. one at point of input box and second at selection of folder. i want to to add a registry key if user try to exit at these two specified location.

pls guide how to do that?
Most Valuable Expert 2012
Top Expert 2014
Commented:
I've added two RegWrite calls that will write to the key specified. These are the two lines I added:
        objShell.RegWrite "HKLM\Software\MyApp\ScriptStatus", "Exited at drive select", "REG_SZ"
      objShell.RegWrite "HKLM\Software\MyApp\ScriptStatus", "Exited at folder select", "REG_SZ"

which can tell you where they exited the script.

Regards,

Rob.
'basic declarations
Const BIF_returnonlyfsdirs   = &H0001
Const BIF_dontgobelowdomain  = &H0002
Const BIF_statustext         = &H0004
Const BIF_returnfsancestors  = &H0008
Const BIF_editbox            = &H0010
Const BIF_validate           = &H0020
Const BIF_browseforcomputer  = &H1000
Const BIF_browseforprinter   = &H2000
Const BIF_browseincludesSourcePaths = &H4000
Dim drv,ssp,CDDrive,sDestinationPath, objFile
Dim fso, fld,homefolder 
 
 
 
setfol()
 
 
Sub setfol()
strComputer="."
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive",,48)
 
For Each objItem In colItems
  colDrives = colDrives & "" & Replace(UCase(objItem.Drive), ":", "")
Next
MsgBox ("Your CD/DVD Drive letter is ")& colDrives & " " & "," & " " &("Please type it."),vbInformation,"CD/DVD Drive Letter"
Valid=False
 
Do
  strDrive = InputBox("Please Type Drive Letter for CD/DVD as displayed", "Select CD/DVD Drive", Strdrive)
  If Instr(colDrives, UCase(strDrive)) > 0 Then Valid=True
  If Trim(strdrive) = "" Then
  	' Add registry key if user has quit at this point
  	Set objShell = CreateObject("WScript.Shell")
  	objShell.RegWrite "HKLM\Software\MyApp\ScriptStatus", "Exited at drive select", "REG_SZ"
  	WScript.Quit
  End If
  Loop Until Valid=True
MsgBox "Thanks for Typing Correct Alphabet " & strDrive,vbInformation,"Correct Drive"
 
 
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.FileSystemObject")
ssp = Strdrive & ":\data"    '(\*.* to copy all)
 
'calling folder selection function
setdesti()
If sDestinationPath = "" Then	
	MsgBox "You did not select a folder."
	objShell.RegWrite "HKLM\Software\MyApp\ScriptStatus", "Exited at folder select", "REG_SZ"
	WScript.Quit
End If
 
 'remove read only tag from destination folder.
homefolder = sDestinationPath
NotReadOnly(HomeFolder)
 
 
  'select destination folder
 'copying code
Ofso.CopyFolder ssp,sDestinationPath,True 
Set fso = Nothing
 
End Sub
 
 
'2: selection for destination folder
sub setdesti()
 sDestinationPath = BrowseForFolder( _
        "Select a sDestinationPath or folder to copy", _
        BIF_returnonlyfsdirs , _
        "")
end sub
 
'3:browse folder function
 
Function BrowseForFolder(title, flag, dir)
    On Error Resume Next
    Dim oShell, oItem, tmp
    ' Create WshShell object.
    Set oShell = WScript.CreateObject("Shell.Application")
    ' Invoke Browse For Folder dialog box.
    Set oItem = oShell.BrowseForFolder(&H0, "Select Destination Folder/Folder ", flag, dir)
    ' Now we try to retrieve the full path.
    BrowseForFolder = oItem.ParentFolder.ParseName(oItem.Title).Path
    Set oShell = Nothing
    Set oItem = Nothing
    On Error GoTo 0
End Function
    
    
'5: code for folder name
 
Sub NotReadOnly(FolderName)
 
    Dim fld, fil, sf
 
    Set fld = fso.GetFolder(FolderName)
    For Each fil In fld.Files
        fil.Attributes = 0
    Next
    For Each sf In fld.SubFolders
        NotReadOnly sf.Path
    Next
 
    Set fil = Nothing
    Set sf = Nothing
    Set fld = Nothing
 
End Sub

Open in new window

Author

Commented:
perfect. thanks .. have u seen linked attached. pls try to help there too.