Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 540
  • Last Modified:

Visual Basic Error Handling

Trying to have error output to a log. It does not seem to be working. If there is an easier way of doing this that would be great. This is what I have:

'Constants
Const FOF_CREATEPROGRESSDLG = &H0&
path = "C:\usertest\"
'Declarations
Set objfso         = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objfso.OpenTextFile("UsermoveTestlist.Csv")
Set objShell = CreateObject("Shell.Application")


Do While Not objTextFile.AtEndOfStream

      'Add error checking and response
      On Error Resume Next
      arrStr       = Split(objTextFile.ReadLine,",")
      oldUser      = arrStr(0)
      newUser      = arrStr(1)
      TargetFolder = path & newUser
      srcFolder    = path & oldUser
      Set objFolder = objShell.NameSpace(TargetFolder)

      'If TargetFolder does not exist. Make it!

      If Not objFSO.FolderExists(srcFolder) or ObjFSO.FolderExists(srcFolder) Then
            WScript.Echo "Creating folder: " & TargetFolder
            objFSO.CreateFolder(TargetFolder)
                 
                       
      
        End If

      WScript.Echo "Attempting to move " & srcFolder & " to " & TargetFolder
      'objFolder.CopyHere TargetFolder, FOF_CREATEPROGRESSDLG
      objFSO.CopyFolder srcFolder , TargetFolder '

Public Sub WriteToErrorLog(ByVal Msg As String,   'getting an error here
       ByVal stkTrace As String, ByVal title As String)

   'check and make the directory if necessary; this is set to look in
   the application folder, you may wish to place the error log in
   another location depending upon the user's role and write access to
   different areas of the file system
    If Not System.IO.Directory.Exists(Application.StartupPath & 
    "\Errors\") Then
        System.IO.Directory.CreateDirectory(Application.StartupPath & 
        "\Errors\")
    End If

    'check the file
    Dim fs As FileStream = New FileStream(Application.StartupPath & 
    "\Errors\errlog.txt", FileMode.OpenOrCreate, FileAccess.ReadWrite)
    Dim s As StreamWriter = New StreamWriter(fs)
    s.Close()
    fs.Close()

    'log it
    Dim fs1 As FileStream = New FileStream(Application.StartupPath & 
    "\Errors\errlog.txt", FileMode.Append, FileAccess.Write)
    Dim s1 As StreamWriter = New StreamWriter(fs1)
    s1.Write("Title: " & title & vbCrLf)
    s1.Write("Message: " & msg & vbCrLf)
    s1.Write("StackTrace: " & stkTrace & vbCrLf)
    s1.Write("Date/Time: " & DateTime.Now.ToString() & vbCrLf)
    s1.Write("================================================" & vbCrLf)
    s1.Close()
    fs1.Close()

End Sub

      Err.Clear
Loop

'Close File stream and clean up
objTextFile.Close

Set fso = Nothing
Set objFolder = Nothing
Set objTextFile = Nothing
Set objShell = Nothing
0
Darrell Kirby
Asked:
Darrell Kirby
  • 3
1 Solution
 
HainKurtSr. System AnalystCommented:
first of all move "Public Sub WriteToErrorLog(...)... end sub" out of loop :)
0
 
HainKurtSr. System AnalystCommented:
second where do you call this WriteToErrorLog?
0
 
HainKurtSr. System AnalystCommented:
i guess you found a vb code and copied pasted into your vb script :)

here how you should do

'Constants
Const FOF_CREATEPROGRESSDLG = &H0&
Const path                  = "C:\temp\"

'Declarations
dim objfso,objTextFile,objShell
Set objfso            = CreateObject("Scripting.FileSystemObject")
Set objTextFile       = objfso.OpenTextFile("UsermoveTestlist.Csv")
Set objShell          = CreateObject("Shell.Application")

sub MoveUserFiles(oldUser, newUser) 
	TargetFolder    = path & newUser
	srcFolder       = path & oldUser
	Set objFolder   = objShell.NameSpace(TargetFolder) 
	
	msgbox "Copy " & oldUser & " --> " & newUser & " started..."
	'If TargetFolder does not exist. Make it!
	If Not ObjFSO.FolderExists(TargetFolder) Then
		WScript.Echo "Creating folder: " & TargetFolder 
		objFSO.CreateFolder(TargetFolder)
	End If

	WScript.Echo "Attempting to move " & srcFolder & " to " & TargetFolder
	objFSO.CopyFolder srcFolder , TargetFolder
	msgbox "Copy " & oldUser & " --> " & newUser & " completed..."
end sub

Do While Not objTextFile.AtEndOfStream
	'Add error checking and response
	On Error resume next
	arrStr          = Split(objTextFile.ReadLine,",")
	oldUser         = arrStr(0)
	newUser         = arrStr(1)
	
	MoveUserFiles oldUser, newUser

	If Err.Number <> 0 Then
		MsgBox ("Error # " & CStr(Err.Number) & " " & Err.Description)
		WriteToErrorLog Err.Number, Err.Description, oldUser & " --> " & newUser
		Err.Clear      ' Clear the error.
	End If
Loop

'Close File stream and clean up
objTextFile.Close

Set fso = Nothing
Set objFolder = Nothing
Set objTextFile = Nothing
Set objShell = Nothing

Public Sub WriteToErrorLog(ByVal Msg, ByVal stkTrace, ByVal title)
	Dim fso, tf
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set tf = fso.OpenTextFile("Errors\errlog.txt", 8, True) ' forAppending, make sure you have Errors folder in running folder
	tf.WriteLine "Title      : " & title
	tf.WriteLine "Message    : " & msg
	tf.WriteLine "StackTrace : " & stkTrace
	tf.WriteLine "Date/Time  : " & Now()
	tf.WriteLine "================================================"
	tf.Close
End Sub

Open in new window

0
 
Darrell KirbyAuthor Commented:
You are correct! I will try this. Thanks!
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now