Runtime Error VBS Script

**Volser** · March 15, 2006

Hallo,

I'm having a problem with an vb script:

strFolder = "D:\Mijn documenten"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(strFolder)

WScript.Echo objFolder.Path

Set colFiles = objFolder.Files

For Each objFile In colFiles

Set fso = CreateObject("Scripting.FileSystemObject")
Set GuyFile = fso.CreateTextFile("D:\test123.txt", True)
GuyFile.WriteLine objFile.Path


Next

ShowSubFolders(objFolder)



Sub ShowSubFolders(objFolder)

  Set colFolders = objFolder.SubFolders

  For Each objSubFolder In colFolders

Set fso = CreateObject("Scripting.FileSystemObject")
Set GuyFile = fso.CreateTextFile("D:\test123.txt", True)
GuyFile.WriteLine objSubFolder.Path

	Set colFiles = objSubFolder.Files

	For Each objFile In colFiles

Set fso = CreateObject("Scripting.FileSystemObject")
Set GuyFile = fso.CreateTextFile("D:\test123.txt", True)
GuyFile.WriteLine objFile.Path

	Next

	ShowSubFolders(objSubFolder)

  Next

End Sub

It lists the firt file and that there's an error telling me it cant access a file.

Can someone please help me with this problem

Greets Volser

**gunsmokingman** · March 15, 2006

Here I re did your script, there where a few errors in it look at mine and you will see the differences

Dim strFolder, Fso, objFolder, objFile, colFiles, TextFile
  strFolder = "D:\Mijn documenten"

  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = Fso.GetFolder(strFolder)
  WScript.Echo objFolder.Path
  Set colFiles = objFolder.Files
  Set TextFile = Fso.CreateTextFile("D:\test123.txt")

   For Each objFile In colFiles
	 TextFile.WriteLine objFile.Path
	Next

	ShowSubFolders(objFolder)

   Sub ShowSubFolders(objFolder)
	Set colFolders = objFolder.SubFolders
	For Each objSubFolder In colFolders
	 TextFile.WriteLine objSubFolder.Path
	Set colFiles = objSubFolder.Files

	For Each objFile In colFiles
	 TextFile.WriteLine objFile.Path
	Next
	ShowSubFolders(objSubFolder)
   Next
  End Sub
TextFile.Close

This is a script I posted a couple of thread below, this list all the files and folder on your hard drives or partitions

Dim Act, CD, CName, colFiles, Ct1, Ct2,FileRpt, Fso, fVar1, fVar2, GB, Ln1, MB, objF, Ts, UName
Dim Subfolder , SubFDC, SubFDLA, SubFDrv, SubFDLM, SubFName, SubFPath, SubFType, ZCD
Dim Time1, Time2, Time3
Time1 = Timer()
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set Act = CreateObject("Wscript.Shell")
  CD = Act.CurrentDirectory
  ZCD = CD : ZCD = Split(ZCD,":")
  CName = Act.ExpandEnvironmentStrings("%ComputerName%")
  UName = Act.ExpandEnvironmentStrings("%UserName%")
  Ln1 = Space(2) & Chr(171) & " ----------- " & Chr(187) & Space(2) 
  MB = 1024 * 1024 : GB = MB * MB 
  FileRpt = (ZCD(0) & "_" & UName & "_DirList.Txt")
  Ct1 = 0 : Ct2 = 0 
  Set Ts = Fso.CreateTextFile(FileRpt)
   Ts.WriteLine Now() &  Ln1 & UName & Ln1 
  ' Ts.WriteBlankLines(2)
'''' START THE SEARCH THREW THE PARENT FOLDER AND SUB FOLDER
  ShowSubfolders Fso.GetFolder(CD)
  FinishScript
Function ShowSubFolders(Folder)
On Error Resume Next 
   For Each Subfolder in Folder.SubFolders
   Ct1 = Ct1 + 1 
   SubFDrv  = "Folder Drive		 : " & Subfolder.Drive
   SubFPath = "Folder Path		  : " & Subfolder.Path
   SubFName = "Folder Name		  : " & Subfolder.Name 
   SubFDC =   "Folder Date Created  : " & Subfolder.DateCreated
   SubFDLA =  "Folder Date Accessed : " & Subfolder.DateLastAccessed
   SubFDLM =  "Folder Date Modified : " & Subfolder.DateLastModified
   SubFType = "Folder Type		  : " & Subfolder.Type
   Set colFiles = Subfolder.Files
   MakeReport
	 ShowSubFolders Subfolder
	Next
   Exit Function
  End Function
  ''''
  Function MakeReport
   Set colFiles = Subfolder.Files
   For Each objF in colFiles
	Ct2 = Ct2 + 1 
	fVar1 = objF.Size
	ConvertFileSize
	 Ts.WriteLine SubFDrv & vbCrLf & SubFPath & vbCrLf & SubFName & vbCrLf & SubFDC
	 Ts.WriteLine SubFDLA & vbCrLf & SubFDLM & vbCrLf & SubFType
	 Ts.WriteLine "File Path			: " & objF.Path
	 Ts.WriteLine "File Name			: " & objF.Name 
	 Ts.WriteLine fVar1
	 Ts.WriteLine "File Date Created	: " & objF.DateCreated
	 Ts.WriteLine "File Date Modified   : " & objF.DateLastModified
	 Ts.WriteLine "File Date Accessed   : " & objF.DateLastAccessed
	 Ts.WriteLine "Folder Type		  : " & objF.Type
	 Ts.WriteLine Ln1 & "Folder Counter : " & Ct1 & Ln1 & "File Counter : " & Ct2 
	 Ts.WriteBlankLines(2)
	Next 
   Exit Function
  End Function
  ''''
  Function ConvertFileSize
	If objF.Size < 999999 Then
	 fVar1 = Left(objF.Size,3) 
	 fVar1 = "File Size			: " & fVar1 & " KB"
	End If
	If objF.Size > 1000000 Then 
	 fVar1 = objF.Size /MB : fVar1 = Left(fVar1,4)
	 fVar1 = "File Size			: " & fVar1 & " MB"
	End If 
	If objF.Size > 1000000000 Then 
	 fVar1 = objF.Size /GB : fVar1 = Left(fVar1,4)
	 fVar1 = "File Size			: " & fVar1 & " GB"
	End If
   Exit Function
  End Function
  '''' 
  Function FinishScript
  Time2 = Timer() 
  Time3 = Time1 - Time2 
  Time3 = Replace(Time3,"-","") 
  If Time3 < 60 Then 
   Time3 = Left(Time3,4)
   Time3 = Time3 & " Seconds"
  Else 
   Time3 = Time3 / 60 
   Time3 = Left(Time3,4)
   Time3 = Time3 & " Minutes"
  End If 
   Ts.WriteLine Ln1 & "Folder Total : " & Ct1 
   Ts.WriteLine Ln1 & "File Total   : " & Ct2 
   Ts.WriteLine Ln1 & "Script Time  : " & Time3
   Ts.Close 
  '''' ASK IF USER WANT TO OPEN FILE
  Q1 = Act.Popup (Space(7) & "Completed Search" & vbCrLf & "Folder Total : " & Ct1 & vbCrLf &_
   "File Total   : " & Ct2 & vbCrLf & "Script Time  : " & Time3 & vbCrLf &_
   "Did You Want To Run This File?" & vbCrLf & FileRpt & vbCrLf &_
   "If Nothing Is Selected In The" & vbCrLf & "Defualt Time Out, Of 5 Minute" & vbCrLf &_ 
   "This Will Then Close And Exit", 301,"Completed Script", 4 + 64)
  If Q1 = VbYes Then : Act.Run(FileRpt) : End If 
  If Q1 = -1 Then : On Error Goto 0 : End If 
   Exit Function
  End Function

Edited March 15, 2006 by gunsmokingman

**Volser** · March 15, 2006

Manny manny thanks people. You really helpt me with this!

Here I re did your script, there where a few errors in it look at mine and you will see the differences

Dim strFolder, Fso, objFolder, objFile, colFiles, TextFile
  strFolder = "D:\Mijn documenten"

  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = Fso.GetFolder(strFolder)
  WScript.Echo objFolder.Path
  Set colFiles = objFolder.Files
  Set TextFile = Fso.CreateTextFile("D:\test123.txt")

   For Each objFile In colFiles
	 TextFile.WriteLine objFile.Path
	Next

	ShowSubFolders(objFolder)

   Sub ShowSubFolders(objFolder)
	Set colFolders = objFolder.SubFolders
	For Each objSubFolder In colFolders
	 TextFile.WriteLine objSubFolder.Path
	Set colFiles = objSubFolder.Files

	For Each objFile In colFiles
	 TextFile.WriteLine objFile.Path
	Next
	ShowSubFolders(objSubFolder)
   Next
  End Sub
TextFile.Close

This is a script I posted a couple of thread below, this list all the files and folder on your hard drives or partitions

Dim Act, CD, CName, colFiles, Ct1, Ct2,FileRpt, Fso, fVar1, fVar2, GB, Ln1, MB, objF, Ts, UName
Dim Subfolder , SubFDC, SubFDLA, SubFDrv, SubFDLM, SubFName, SubFPath, SubFType, ZCD
Dim Time1, Time2, Time3
Time1 = Timer()
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set Act = CreateObject("Wscript.Shell")
  CD = Act.CurrentDirectory
  ZCD = CD : ZCD = Split(ZCD,":")
  CName = Act.ExpandEnvironmentStrings("%ComputerName%")
  UName = Act.ExpandEnvironmentStrings("%UserName%")
  Ln1 = Space(2) & Chr(171) & " ----------- " & Chr(187) & Space(2) 
  MB = 1024 * 1024 : GB = MB * MB 
  FileRpt = (ZCD(0) & "_" & UName & "_DirList.Txt")
  Ct1 = 0 : Ct2 = 0 
  Set Ts = Fso.CreateTextFile(FileRpt)
   Ts.WriteLine Now() &  Ln1 & UName & Ln1 
  ' Ts.WriteBlankLines(2)
'''' START THE SEARCH THREW THE PARENT FOLDER AND SUB FOLDER
  ShowSubfolders Fso.GetFolder(CD)
  FinishScript
Function ShowSubFolders(Folder)
On Error Resume Next 
   For Each Subfolder in Folder.SubFolders
   Ct1 = Ct1 + 1 
   SubFDrv  = "Folder Drive		 : " & Subfolder.Drive
   SubFPath = "Folder Path		  : " & Subfolder.Path
   SubFName = "Folder Name		  : " & Subfolder.Name 
   SubFDC =   "Folder Date Created  : " & Subfolder.DateCreated
   SubFDLA =  "Folder Date Accessed : " & Subfolder.DateLastAccessed
   SubFDLM =  "Folder Date Modified : " & Subfolder.DateLastModified
   SubFType = "Folder Type		  : " & Subfolder.Type
   Set colFiles = Subfolder.Files
   MakeReport
	 ShowSubFolders Subfolder
	Next
   Exit Function
  End Function
  ''''
  Function MakeReport
   Set colFiles = Subfolder.Files
   For Each objF in colFiles
	Ct2 = Ct2 + 1 
	fVar1 = objF.Size
	ConvertFileSize
	 Ts.WriteLine SubFDrv & vbCrLf & SubFPath & vbCrLf & SubFName & vbCrLf & SubFDC
	 Ts.WriteLine SubFDLA & vbCrLf & SubFDLM & vbCrLf & SubFType
	 Ts.WriteLine "File Path			: " & objF.Path
	 Ts.WriteLine "File Name			: " & objF.Name 
	 Ts.WriteLine fVar1
	 Ts.WriteLine "File Date Created	: " & objF.DateCreated
	 Ts.WriteLine "File Date Modified   : " & objF.DateLastModified
	 Ts.WriteLine "File Date Accessed   : " & objF.DateLastAccessed
	 Ts.WriteLine "Folder Type		  : " & objF.Type
	 Ts.WriteLine Ln1 & "Folder Counter : " & Ct1 & Ln1 & "File Counter : " & Ct2 
	 Ts.WriteBlankLines(2)
	Next 
   Exit Function
  End Function
  ''''
  Function ConvertFileSize
	If objF.Size < 999999 Then
	 fVar1 = Left(objF.Size,3) 
	 fVar1 = "File Size			: " & fVar1 & " KB"
	End If
	If objF.Size > 1000000 Then 
	 fVar1 = objF.Size /MB : fVar1 = Left(fVar1,4)
	 fVar1 = "File Size			: " & fVar1 & " MB"
	End If 
	If objF.Size > 1000000000 Then 
	 fVar1 = objF.Size /GB : fVar1 = Left(fVar1,4)
	 fVar1 = "File Size			: " & fVar1 & " GB"
	End If
   Exit Function
  End Function
  '''' 
  Function FinishScript
  Time2 = Timer() 
  Time3 = Time1 - Time2 
  Time3 = Replace(Time3,"-","") 
  If Time3 < 60 Then 
   Time3 = Left(Time3,4)
   Time3 = Time3 & " Seconds"
  Else 
   Time3 = Time3 / 60 
   Time3 = Left(Time3,4)
   Time3 = Time3 & " Minutes"
  End If 
   Ts.WriteLine Ln1 & "Folder Total : " & Ct1 
   Ts.WriteLine Ln1 & "File Total   : " & Ct2 
   Ts.WriteLine Ln1 & "Script Time  : " & Time3
   Ts.Close 
  '''' ASK IF USER WANT TO OPEN FILE
  Q1 = Act.Popup (Space(7) & "Completed Search" & vbCrLf & "Folder Total : " & Ct1 & vbCrLf &_
   "File Total   : " & Ct2 & vbCrLf & "Script Time  : " & Time3 & vbCrLf &_
   "Did You Want To Run This File?" & vbCrLf & FileRpt & vbCrLf &_
   "If Nothing Is Selected In The" & vbCrLf & "Defualt Time Out, Of 5 Minute" & vbCrLf &_ 
   "This Will Then Close And Exit", 301,"Completed Script", 4 + 64)
  If Q1 = VbYes Then : Act.Run(FileRpt) : End If 
  If Q1 = -1 Then : On Error Goto 0 : End If 
   Exit Function
  End Function

**gunsmokingman** · March 15, 2006

Your welcome and if you need any more help just post here and I wil try and help.

**Volser** · March 15, 2006

At the moment i'm trying to make a vbs script from a batch file. The vbs script has to have the same funktions exept it has to use only files with the .dll or only files with the .ocx extension from the 010.txt file.

I hope anyone knows an answer for this. The file makes an copy of the registry and than it registeres the files. It selects the files from the txt file. This is my batch file:

@ECHO OFF
TITLE Registering DLL/OCX/EXE Files
ECHO.
ECHO.
ECHO Starting...
ECHO.
ECHO.
set art=c:\art\
start /wait c:\art\Art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making Registry Copy Done!!!
ECHO.
ECHO.
FOR /F %%i IN (C:\010.txt.txt) DO regsvr32.exe /s %%i
ECHO Registering DLL Files Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /c c:\art\ART_DB.rgf -fr:c:\art\DLL.reg
ECHO Extracting .rgf File To .Reg File Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
FOR /F %%i IN (C:\010.txt.txt) DO regsvr32.exe /s %%i
ECHO Registering OCX Files Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /c c:\art\ART_DB.rgf -fr:c:\art\OCX.reg
ECHO Extracting .rgf File To .Reg File Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
FOR /F %%i IN (C:\010.txt.txt) DO %%i /install /silent
ECHO Registering EXE -Service Files Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /c c:\art\ART_DB.rgf -fr:c:\art\EXE-Service.reg
ECHO Extracting .rgf File To .Reg File Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
FOR /F %%i IN (C:\010.txt.txt) DO %%i /regserver.exe
ECHO Registering EXE -Register Files Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /s c:\art\ART_DB.rgf -a -b -f:exclude
ECHO Making New Registry Copy Done!!!
ECHO.
ECHO.
start /wait c:\art\art.exe /c c:\art\ART_DB.rgf -fr:c:\art\EXE-Register.reg
ECHO Extracting .rgf File To .Reg File Done!!!
ECHO.
ECHO.
ECHO Done!!!

Your welcome and if you need any more help just post here and I wil try and help.

**gunsmokingman** · March 15, 2006

You could do that all in VBS, all you would have to do is set up a collection of the folder and files

then use a if exists statement to check if it a dll or ocx.

Example you will have to add the rest

On Error Resume Next 
   Dim Act, Fso, Ext, StartFolder, Run1, Run2, Run3
   Set Fso = CreateObject("Scripting.FileSystemObject")
   Set Act = CreateObject("Wscript.Shell") 
   '''' PLACE THE FOLDER AND PATH HERE
   StartFolder = "C:\Scripts"
   '''' CMD PROMT SCRIPTS 
   Run1 = "c:\art\Art.exe /s"
   Run2 = "c:\art\ART_DB.rgf -a -b -f"
   Run3 = "c:\art\ART_DB.rgf -fr"
	Set objFolder = Fso.GetFolder(StartFolder)
	Set colFiles = objFolder.Files
	 For Each objFile in colFiles
	  Ext = Right(objFile.Name,3)
	   If Ext = "dll" Then 
		MsgBox "Found A Dll file extention", 0 + 32, "Dll File"
	   '''' UNCOMMENT THE LINE BELOW TO MAKE ACTIVE
	   '  Act.Run(Run1),1,True
	   '  Act.Run(Run2),1,True
	   End If 
	   If Ext = "ocx" Then 
		MsgBox "Found A OCX file extention", 0 + 32, "Ocx File"
	   '''' UNCOMMENT THE LINE BELOW TO MAKE ACTIVE
	   '  Act.Run(Run1),1,True
	  End If 
	 Next

**Volser** · March 15, 2006

Sorry bud i dont really know what to do with that code

The problem is that i'm havind a folder with a lott of subfolders. In these folders are dll ocx and other files. I have to register a file make a register backup with a seperate name for each file. The file's that have to be registered are dll and ocx file's. The script hase to make a backup copy after each file registration. To do that for all files(over 1000) kosts way to mutch time. Sow im traying to make a script that reads the folders and places alle links in a text file. Than it hase to open the textfile en has to register all the dll and ocx files. Making a backup after every file that has bin registerd. I know its a lot of work bud its kost more time to do this every time than to make a script do it for me.

I hope that there is anyone who can help me with making a script to do that . I'm using ARI(Advanced RegistryTracer) to make a copy of the register

Sign In

Runtime Error VBS Script

Recommended Posts

Volser

Link to comment

Share on other sites

gunsmokingman

Link to comment

Share on other sites

Volser

Link to comment

Share on other sites

gunsmokingman

Link to comment

Share on other sites

Volser

Link to comment

Share on other sites

gunsmokingman

Link to comment

Share on other sites

Volser

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members

Activity

Browse