drjoeross1
asked on
File & Folder Creation Fail on SOME XP Machines
I have a program that allows Drag/Drop of eml files from Outlook Express to our program to copy them to our program's subdirectory (it is a unique anti-spam program).
If the subdirecotory does not exist, the program uses the FileSystemObject to create it. Then the files are copied to that directory by a simple File Open file for output & Print operation.
On some XP computers users report the subdirectory is created but no files appear in it and there is NO error message. On other XP computers (one is at my office) the Subdirectory is NOT created and so the files are not either... and there is NO error!!
The install seems to run ok with no reported errors. I am using InnoSetup and installing the scripting library using microsofts program for this purpose and NOT trying to install scrrun.dll manually.
I find this really bizzare, since the program works great 3 of my home computers. Here is a cut of the code section that does these tasks:
--------------------- cut of code --------------------------
'create dir if not existing
If Dir(App.Path & "\BadMail\") = "" Then
fso.CreateFolder (App.Path & "\BadMail\")
End If
'get a unique file name, the function is stored in modFileSave.
strEmlFile = MakeUniqueFileName(App.Pat
msg = "An Email COPY will be saved to the following path and file name: " _
& vbCrLf & App.Path & "\BadMail\" & strEmlFile
MsgBox msg, vbOKOnly, "Please check to see if it was saved there!"
fileHandle = FreeFile
Open App.Path & "\badMail\" & strEmlFile For Output As #fileHandle
Print #fileHandle, strData
Close #fileHandle
--------------------------
I have postulated that some program is preventing the creation of EML files as they must be scanned be scanned by Norton before saving to the hard disk but that does not explain the lack of dirctory creation. Also, this files were not created even with Norton deactivated. As far as I know the install was done from a Administrator enabled user. I believe this failure was on XP Machines Home Ed.
Thanks,
Joe
If the subdirecotory does not exist, the program uses the FileSystemObject to create it. Then the files are copied to that directory by a simple File Open file for output & Print operation.
On some XP computers users report the subdirectory is created but no files appear in it and there is NO error message. On other XP computers (one is at my office) the Subdirectory is NOT created and so the files are not either... and there is NO error!!
The install seems to run ok with no reported errors. I am using InnoSetup and installing the scripting library using microsofts program for this purpose and NOT trying to install scrrun.dll manually.
I find this really bizzare, since the program works great 3 of my home computers. Here is a cut of the code section that does these tasks:
--------------------- cut of code --------------------------
'create dir if not existing
If Dir(App.Path & "\BadMail\") = "" Then
fso.CreateFolder (App.Path & "\BadMail\")
End If
'get a unique file name, the function is stored in modFileSave.
strEmlFile = MakeUniqueFileName(App.Pat
msg = "An Email COPY will be saved to the following path and file name: " _
& vbCrLf & App.Path & "\BadMail\" & strEmlFile
MsgBox msg, vbOKOnly, "Please check to see if it was saved there!"
fileHandle = FreeFile
Open App.Path & "\badMail\" & strEmlFile For Output As #fileHandle
Print #fileHandle, strData
Close #fileHandle
--------------------------
I have postulated that some program is preventing the creation of EML files as they must be scanned be scanned by Norton before saving to the hard disk but that does not explain the lack of dirctory creation. Also, this files were not created even with Norton deactivated. As far as I know the install was done from a Administrator enabled user. I believe this failure was on XP Machines Home Ed.
Thanks,
Joe
inthedark
You should not use the scripting control as some users may have script blocking turned on. So any scripting control commands may or may not work.
Also you display the message before the file is saved, which may cause confusion.
Here are some replacements for the scripting object. Also you were using the Dir command which has been know to fail for serveral reasons. So it needs to be retried a few times. By placing code which can fail with a result you can test to see if each step worked.
Dim GF as New zGF ' place all of your handy functions into a class module, say called zGF
Dim OK
If Not GF.FolderExists("c:\MyFold
OK = GF.MakeDir("c:\MyFolder")
If Not OK Then
MsgBox "Could not create folder: xxx" + GF.ErrorMessage
End If
End If
etc.
And to save the file:
OK = GF.WriteFileOK(strEmlFile , strData)
If Not OK Then
MsgBox "Could not create folder: xxx" + GF.ErrorMessage
End If
--------------------------
Public ErrorMessage As String
Public ErrorNumber As Long
Public Enum SlashOptions
RemoveSlash = 0
KeepSlash = 1
End Enum
Const MinutesPerDay As Double = 24# * 60#
Const SecondsPerDay As Double = MinutesPerDay * 60#
Const OneSecond As Double = 1# / SecondsPerDay
Const MillisecondsPerDay As Double = SecondsPerDay * 1000#
Const mdblOneSecond As Double = 1# / (60# * 1440#)
Const mdblOneMinute As Double = 1# / (1440#)
Public Function FileExists(psFileName As String) As Boolean
' Same as OK = Len(Dir("......"))>0 without any errors
' Fail safe test for a file name
Dim sFIle As String
sFIle = psFileName
FileExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
' wait for drive to speed up
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 1 ' wait for one second for the drive to speed up
End If
If Len(Dir(sFIle)) = 0 Then
FileExists = True
End If
End Function
Public Function FolderExists(psFolderName As String) As Boolean
Dim sFolder As String
sFolder = psFolderName
CheckSlash sFolder, RemoveSlash
FolderExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 5
End If
If Len(Dir(sFolder, vbDirectory)) = 0 Then
FolderExists = True
End If
End Function
Public Function MkDirOK(NewPath As String) As Boolean
' Create new path
Dim p$
p$ = NewPath
If Right(p$, 1) = "\" Then
p$ = Left(p$, Len(p$) - 1)
End If
On Error Resume Next
MkDir p$
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
MkDirOK = False
Else
MkDirOK = True
End If
End Function
Public Sub CheckSlash(FolderName, Optional KeepSlash As SlashOptions = SlashOptions.KeepSlash)
' Removes/puts a slash at the end of a folder path
' GF.CheckSlash sFolderName ' make sure has a slash
' GF.CheckSlash sFolderName, SlashOptions.RemoveSlash ' remove slash if present
If KeepSlash = SlashOptions.KeepSlash Then
If Right(FolderName, 1) <> "\" Then
FolderName = FolderName + "\"
End If
Else
If Right(FolderName, 1) = "\" Then
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
End If
End Sub
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
Public Function IDE(Optional Genuine As Boolean) As Boolean
' Returns True if running in debug (IDE) mode
' False if running in an EXE
'Example:
' If ADO.IDE Then Stop
If Not Genuine And LiveMode Then
IDE = False
Exit Function
End If
Static mIDEDone As Boolean
Static mIDE As Boolean
If Not mIDEDone Then ' See below
'To make this function work you need the following in your
' class declarations:
'Dim mIDEDone As Boolean
'Dim mIDE As Boolean
' just do this first time round then store the result
On Error Resume Next
Err.Clear
Debug.Print 1 / 0;
If Err.Number <> 0 Then
mIDE = True
Else
mIDE = False
End If
mIDEDone = True
End If
IDE = mIDE
End Function
Public Function WriteFileOK(FileName As String, DataString) As Boolean
' saves DataString to a file FileName
' returns True if OK
Dim wlfn As Long
wlfn = FreeFile
On Error Resume Next
Err.Clear
WriteFileOK = False
Open FileName For Output As #wlfn
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
Exit Function
End If
Print #wlfn, DataString;
Close wlfn
If Err.Number <> 0 Then
Exit Function
End If
WriteFileOK = True
End Function
Dim GF as New zGF ' place all of your handy functions into a class module, say called zGF
Dim OK
If Not GF.FolderExists("c:\MyFold
OK = GF.MakeDir("c:\MyFolder")
If Not OK Then
MsgBox "Could not create folder: xxx" + GF.ErrorMessage
End If
End If
etc.
And to save the file:
OK = GF.WriteFileOK(strEmlFile , strData)
If Not OK Then
MsgBox "Could not create folder: xxx" + GF.ErrorMessage
End If
--------------------------
Public ErrorMessage As String
Public ErrorNumber As Long
Public Enum SlashOptions
RemoveSlash = 0
KeepSlash = 1
End Enum
Const MinutesPerDay As Double = 24# * 60#
Const SecondsPerDay As Double = MinutesPerDay * 60#
Const OneSecond As Double = 1# / SecondsPerDay
Const MillisecondsPerDay As Double = SecondsPerDay * 1000#
Const mdblOneSecond As Double = 1# / (60# * 1440#)
Const mdblOneMinute As Double = 1# / (1440#)
Public Function FileExists(psFileName As String) As Boolean
' Same as OK = Len(Dir("......"))>0 without any errors
' Fail safe test for a file name
Dim sFIle As String
sFIle = psFileName
FileExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
' wait for drive to speed up
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 1 ' wait for one second for the drive to speed up
End If
If Len(Dir(sFIle)) = 0 Then
FileExists = True
End If
End Function
Public Function FolderExists(psFolderName As String) As Boolean
Dim sFolder As String
sFolder = psFolderName
CheckSlash sFolder, RemoveSlash
FolderExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 5
End If
If Len(Dir(sFolder, vbDirectory)) = 0 Then
FolderExists = True
End If
End Function
Public Function MkDirOK(NewPath As String) As Boolean
' Create new path
Dim p$
p$ = NewPath
If Right(p$, 1) = "\" Then
p$ = Left(p$, Len(p$) - 1)
End If
On Error Resume Next
MkDir p$
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
MkDirOK = False
Else
MkDirOK = True
End If
End Function
Public Sub CheckSlash(FolderName, Optional KeepSlash As SlashOptions = SlashOptions.KeepSlash)
' Removes/puts a slash at the end of a folder path
' GF.CheckSlash sFolderName ' make sure has a slash
' GF.CheckSlash sFolderName, SlashOptions.RemoveSlash ' remove slash if present
If KeepSlash = SlashOptions.KeepSlash Then
If Right(FolderName, 1) <> "\" Then
FolderName = FolderName + "\"
End If
Else
If Right(FolderName, 1) = "\" Then
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
End If
End Sub
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
Public Function IDE(Optional Genuine As Boolean) As Boolean
' Returns True if running in debug (IDE) mode
' False if running in an EXE
'Example:
' If ADO.IDE Then Stop
If Not Genuine And LiveMode Then
IDE = False
Exit Function
End If
Static mIDEDone As Boolean
Static mIDE As Boolean
If Not mIDEDone Then ' See below
'To make this function work you need the following in your
' class declarations:
'Dim mIDEDone As Boolean
'Dim mIDE As Boolean
' just do this first time round then store the result
On Error Resume Next
Err.Clear
Debug.Print 1 / 0;
If Err.Number <> 0 Then
mIDE = True
Else
mIDE = False
End If
mIDEDone = True
End If
IDE = mIDE
End Function
Public Function WriteFileOK(FileName As String, DataString) As Boolean
' saves DataString to a file FileName
' returns True if OK
Dim wlfn As Long
wlfn = FreeFile
On Error Resume Next
Err.Clear
WriteFileOK = False
Open FileName For Output As #wlfn
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
Exit Function
End If
Print #wlfn, DataString;
Close wlfn
If Err.Number <> 0 Then
Exit Function
End If
WriteFileOK = True
End Function
ASKER
Greetings,
Thanks for your response... some things I do not understand. I gather that you are suggesting NOT using the Scripting Object because users can have that turned off somewhere. I will research this and It seems to make sense.... perhaps this is the problem I am seeing.
I gather that you want each process to REPORT on its success or failure and that is quite logical so I will add that.
The removal / insertiion of the "slash" makes sense though since all my directories are subdirectories, I believe the slash does not fail, unless I miss something.
However the Cls funtion you kindly shared does not make sense to me. I have added some comments as I watched it process I appended a comment and my name at each point and I am re-pasting it here so you can see my questions, thank you,
There are 5 comments/questions indicated as:
'<=== (1) Question xxxxxx xxxxxxxxxxxxxx joe 11/04
-------------------- cls with Questions --------------------------
Public ErrorMessage As String
Public ErrorNumber As Long
Public Enum SlashOptions
RemoveSlash = 0
KeepSlash = 1
End Enum
Const MinutesPerDay As Double = 24# * 60#
Const SecondsPerDay As Double = MinutesPerDay * 60#
Const OneSecond As Double = 1# / SecondsPerDay
Const MillisecondsPerDay As Double = SecondsPerDay * 1000#
Const mdblOneSecond As Double = 1# / (60# * 1440#)
Const mdblOneMinute As Double = 1# / (1440#)
Public Function FileExists(psFileName As String) As Boolean
' Same as OK = Len(Dir("......"))>0 without any errors
' Fail safe test for a file name
Dim sFIle As String
sFIle = psFileName
FileExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
' wait for drive to speed up
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 1 ' wait for one second for the drive to speed up
End If
If Len(Dir(sFIle)) = 0 Then
FileExists = True
End If
End Function
Public Function FolderExists(psFolderName As String) As Boolean
Dim sFolder As String
sFolder = psFolderName
CheckSlash sFolder, RemoveSlash
FolderExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then '<=== (1) there is no variable to be labled as FALSE What are we testing?? 11/04 Joe
ErrorTrap:
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 5
End If
If Len(Dir(sFolder, vbDirectory)) = 0 Then '<=== (2)This function seems like it should report True if Len > 0 ??? 11/04 Joe
FolderExists = True
End If
End Function
Public Function MkDirOK(NewPath As String) As Boolean
' Create new path
Dim p$
p$ = NewPath
If Right(p$, 1) = "\" Then
p$ = Left(p$, Len(p$) - 1)
End If
On Error Resume Next
MkDir p$
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
MkDirOK = False
Else
MkDirOK = True
End If
End Function
Public Sub CheckSlash(FolderName, Optional KeepSlash As SlashOptions = SlashOptions.KeepSlash)
' Removes/puts a slash at the end of a folder path
' GF.CheckSlash sFolderName ' make sure has a slash
' GF.CheckSlash sFolderName, SlashOptions.RemoveSlash ' remove slash if present
If KeepSlash = SlashOptions.KeepSlash Then
If Right(FolderName, 1) <> "\" Then
FolderName = FolderName + "\"
End If
Else
If Right(FolderName, 1) = "\" Then
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
End If
End Sub
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
Public Function IDE(Optional Genuine As Boolean) As Boolean
' Returns True if running in debug (IDE) mode
' False if running in an EXE
'Example:
' If ADO.IDE Then Stop
If Not Genuine And LiveMode Then '<===(3) "LiveMode" has NO reference anywhere?? JOE 11/04
IDE = False '<=== (4)What would "genuine" indicate???? Joe 11/04
Exit Function
End If
Static mIDEDone As Boolean
Static mIDE As Boolean
If Not mIDEDone Then ' See below
'To make this function work you need the following in your
' class declarations:
'Dim mIDEDone As Boolean
'Dim mIDE As Boolean
' just do this first time round then store the result
On Error Resume Next
Err.Clear
Debug.Print 1 / 0; '<===(5)causes error in IDE mode and stops operation. What's the value? Joe 11/04
If Err.Number <> 0 Then
mIDE = True
Else
mIDE = False
End If
mIDEDone = True
End If
IDE = mIDE
End Function
Public Function WriteFileOK(FileName As String, DataString) As Boolean
' saves DataString to a file FileName
' returns True if OK
Dim wlfn As Long
wlfn = FreeFile
On Error Resume Next
Err.Clear
WriteFileOK = False
Open FileName For Output As #wlfn
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
Exit Function
End If
Print #wlfn, DataString;
Close wlfn
If Err.Number <> 0 Then
Exit Function
End If
WriteFileOK = True
End Function
------------------------- end paste --------------------------
Thanks for your clarifcation
Joe
Thanks for your response... some things I do not understand. I gather that you are suggesting NOT using the Scripting Object because users can have that turned off somewhere. I will research this and It seems to make sense.... perhaps this is the problem I am seeing.
I gather that you want each process to REPORT on its success or failure and that is quite logical so I will add that.
The removal / insertiion of the "slash" makes sense though since all my directories are subdirectories, I believe the slash does not fail, unless I miss something.
However the Cls funtion you kindly shared does not make sense to me. I have added some comments as I watched it process I appended a comment and my name at each point and I am re-pasting it here so you can see my questions, thank you,
There are 5 comments/questions indicated as:
'<=== (1) Question xxxxxx xxxxxxxxxxxxxx joe 11/04
-------------------- cls with Questions --------------------------
Public ErrorMessage As String
Public ErrorNumber As Long
Public Enum SlashOptions
RemoveSlash = 0
KeepSlash = 1
End Enum
Const MinutesPerDay As Double = 24# * 60#
Const SecondsPerDay As Double = MinutesPerDay * 60#
Const OneSecond As Double = 1# / SecondsPerDay
Const MillisecondsPerDay As Double = SecondsPerDay * 1000#
Const mdblOneSecond As Double = 1# / (60# * 1440#)
Const mdblOneMinute As Double = 1# / (1440#)
Public Function FileExists(psFileName As String) As Boolean
' Same as OK = Len(Dir("......"))>0 without any errors
' Fail safe test for a file name
Dim sFIle As String
sFIle = psFileName
FileExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then
ErrorTrap:
' wait for drive to speed up
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 1 ' wait for one second for the drive to speed up
End If
If Len(Dir(sFIle)) = 0 Then
FileExists = True
End If
End Function
Public Function FolderExists(psFolderName As String) As Boolean
Dim sFolder As String
sFolder = psFolderName
CheckSlash sFolder, RemoveSlash
FolderExists = False
If Not IDE Then
On Error GoTo ErrorTrap
End If
If False Then '<=== (1) there is no variable to be labled as FALSE What are we testing?? 11/04 Joe
ErrorTrap:
Dim lTry As Long
lTry = lTry + 1
If lTry > 10 Then
Exit Function
End If
Delay 5
End If
If Len(Dir(sFolder, vbDirectory)) = 0 Then '<=== (2)This function seems like it should report True if Len > 0 ??? 11/04 Joe
FolderExists = True
End If
End Function
Public Function MkDirOK(NewPath As String) As Boolean
' Create new path
Dim p$
p$ = NewPath
If Right(p$, 1) = "\" Then
p$ = Left(p$, Len(p$) - 1)
End If
On Error Resume Next
MkDir p$
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
MkDirOK = False
Else
MkDirOK = True
End If
End Function
Public Sub CheckSlash(FolderName, Optional KeepSlash As SlashOptions = SlashOptions.KeepSlash)
' Removes/puts a slash at the end of a folder path
' GF.CheckSlash sFolderName ' make sure has a slash
' GF.CheckSlash sFolderName, SlashOptions.RemoveSlash ' remove slash if present
If KeepSlash = SlashOptions.KeepSlash Then
If Right(FolderName, 1) <> "\" Then
FolderName = FolderName + "\"
End If
Else
If Right(FolderName, 1) = "\" Then
FolderName = Left(FolderName, Len(FolderName) - 1)
End If
End If
End Sub
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
Public Function IDE(Optional Genuine As Boolean) As Boolean
' Returns True if running in debug (IDE) mode
' False if running in an EXE
'Example:
' If ADO.IDE Then Stop
If Not Genuine And LiveMode Then '<===(3) "LiveMode" has NO reference anywhere?? JOE 11/04
IDE = False '<=== (4)What would "genuine" indicate???? Joe 11/04
Exit Function
End If
Static mIDEDone As Boolean
Static mIDE As Boolean
If Not mIDEDone Then ' See below
'To make this function work you need the following in your
' class declarations:
'Dim mIDEDone As Boolean
'Dim mIDE As Boolean
' just do this first time round then store the result
On Error Resume Next
Err.Clear
Debug.Print 1 / 0; '<===(5)causes error in IDE mode and stops operation. What's the value? Joe 11/04
If Err.Number <> 0 Then
mIDE = True
Else
mIDE = False
End If
mIDEDone = True
End If
IDE = mIDE
End Function
Public Function WriteFileOK(FileName As String, DataString) As Boolean
' saves DataString to a file FileName
' returns True if OK
Dim wlfn As Long
wlfn = FreeFile
On Error Resume Next
Err.Clear
WriteFileOK = False
Open FileName For Output As #wlfn
If Err.Number <> 0 Then
ErrorMessage = Err.Description
ErrorNumber = Err.Number
Exit Function
End If
Print #wlfn, DataString;
Close wlfn
If Err.Number <> 0 Then
Exit Function
End If
WriteFileOK = True
End Function
------------------------- end paste --------------------------
Thanks for your clarifcation
Joe
(1) The idea here is that you can paste this code into the start of any sub or function, I have different variations of how the error handling is done, I just paste the pre-created code at the top of the function.
What the "If False" does is say don't execute
If False Then '<=== (1)
' Anything here will be ignored (but in our case the error will force the function tor estart after a short delay.
End If
(2) You are right, its a bug.
It did say this:
If Dir(sFolder, vbDirectory)) <> "" Then
FolderExists = True
End If
But it is faster to test with Len so I edited and did not test, so as you sugget it should say:
If Len(Dir(sFolder, vbDirectory)) <> 0 Then
FolderExists = True
End If
(3)
At the start of the class you need:
Const LiveMode As Boolean = False ' Edit this to True inorder to test your error handling.
In the following example when I am testing my function I want all erros to fail so that I may correct and faults in the code
Public Function Example() As Something
If Not IDE Then
On Error GoTo ErrorTrap ' this will only become active in a Compiled exe
End If
' now do some code which can fail
' and may end like this
Exit Function
ErrorTrap:
MsgBox "We have a problem"
End Function
By changing LiveMode = True, when you run in the IDE te ErrorTrap will be set.
(4)
Sometimes you always need to know if you are in IDE or EXE. For example, in an IIS application the following code will work on NT in an IDE but it will hang your app on Win 2000+ (and machine needs a reboot).
Application.Lock ' wait until you have exclusive rights to change an application variable
Application("Counter") = Application("Counter") ' <====IDE hangs here, but EXE works fine.
Application.UnLock
So irrespective of the LiveMode setting you need to know if in IDE so you can recode like this to avoice system hang:
bSkipLock = GF.IDE(True) ' Is it realy in IDE?
If Not bSkipLock Then
Application.Lock ' wait until you have exclusive rights to change an application variable
End If
Application("Counter") = Application("Counter") ' <====IDE hangs here, but EXE works fine.
If Not bSkipLock Then
Application.UnLock
End If
(5)
Debug.Print 1/0 ' is just a simple way of finding if your are in IDE.
In an EXE the Debug statments are ignored so Err.Number will always be zero.
Hope this helps:~)
What the "If False" does is say don't execute
If False Then '<=== (1)
' Anything here will be ignored (but in our case the error will force the function tor estart after a short delay.
End If
(2) You are right, its a bug.
It did say this:
If Dir(sFolder, vbDirectory)) <> "" Then
FolderExists = True
End If
But it is faster to test with Len so I edited and did not test, so as you sugget it should say:
If Len(Dir(sFolder, vbDirectory)) <> 0 Then
FolderExists = True
End If
(3)
At the start of the class you need:
Const LiveMode As Boolean = False ' Edit this to True inorder to test your error handling.
In the following example when I am testing my function I want all erros to fail so that I may correct and faults in the code
Public Function Example() As Something
If Not IDE Then
On Error GoTo ErrorTrap ' this will only become active in a Compiled exe
End If
' now do some code which can fail
' and may end like this
Exit Function
ErrorTrap:
MsgBox "We have a problem"
End Function
By changing LiveMode = True, when you run in the IDE te ErrorTrap will be set.
(4)
Sometimes you always need to know if you are in IDE or EXE. For example, in an IIS application the following code will work on NT in an IDE but it will hang your app on Win 2000+ (and machine needs a reboot).
Application.Lock ' wait until you have exclusive rights to change an application variable
Application("Counter") = Application("Counter") ' <====IDE hangs here, but EXE works fine.
Application.UnLock
So irrespective of the LiveMode setting you need to know if in IDE so you can recode like this to avoice system hang:
bSkipLock = GF.IDE(True) ' Is it realy in IDE?
If Not bSkipLock Then
Application.Lock ' wait until you have exclusive rights to change an application variable
End If
Application("Counter") = Application("Counter") ' <====IDE hangs here, but EXE works fine.
If Not bSkipLock Then
Application.UnLock
End If
(5)
Debug.Print 1/0 ' is just a simple way of finding if your are in IDE.
In an EXE the Debug statments are ignored so Err.Number will always be zero.
Hope this helps:~)
PS divide anything by zero and you get an overflow error becuase the result is infinity
ASKER
So far I am not sure this is working. I have a question about the delay area. It seems that the "GetNow " is not being used? Is there a missing sub for function for the "GetNow" ??
Thanks,
Joe
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
Thanks,
Joe
Public Sub Delay(DelaySeconds As Single)
' wait for time to pass
' GF.Delay 10 ' wait for 10 seconds
Dim WaitUntil As Date
WaitUntil = GetNow + (CDbl(DelaySeconds) * mdblOneSecond)
Do While GetNow < WaitUntil
Sleep 100
DoEvents
Loop
End Sub
ASKER
I also noticed (later ... sorry) that the "SLEEP" statement relates to nothing... and causes an error. What is this supposed to be?
Thanks again,
Joe
Thanks again,
Joe
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
And sleep is processor friendly:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
ASKER
Sorry for the delay in repsonding but the one user who has the problem is away on vaction.... He will be back this next week and I will test your solution on his computer
Joe
Joe
ASKER
I have asked the beta tester to run the new program following InTheDark's recommendations. Since we are close to the Holidays it is taking time to get an answer. .... not to mention that he went to Tahiti for 3 weeks prior.
Anyway, I should get feedback in a few days. If its your policy to close at this point.... that is you decision. InTheDark certainly made some good recommendations..... but I have not been able to confirm that using the FSO Scripting is in fact being blocked by programs like Norton A/V.... the premise of this dialog (I believe).
Thank you,
Joe
Anyway, I should get feedback in a few days. If its your policy to close at this point.... that is you decision. InTheDark certainly made some good recommendations..... but I have not been able to confirm that using the FSO Scripting is in fact being blocked by programs like Norton A/V.... the premise of this dialog (I believe).
Thank you,
Joe
ASKER
Greetings:
The suggestion by "InTheDark" appears to have solved the problem! It appears that the VB Scripting Object is blocked by some A/V or other programs.
Thank you,
Joe
The suggestion by "InTheDark" appears to have solved the problem! It appears that the VB Scripting Object is blocked by some A/V or other programs.
Thank you,
Joe