R
Rick
I have a problem in Windows XP since I created a FileSystemObject to
manipulate folders and files in an Access procedure. In XP (from the Access
File menu), when I try to rename a file, copy/paste a file, or delete a file,
the directory screen doesn't immediately refresh. I have to close and reopen
the XP File directory to see the changes. This began occurring since I
implemented the following code using the Scripting.FileSystemObject. Any
ideas? Thanks.
Public Sub cmdTransferToExcel_Click()
Dim fso As Scripting.FileSystemObject
Dim strFileName As String
Dim strFilePath As String
Dim strFileAndPath As String
Dim strDataSource As String
Dim i As Integer
On Error GoTo ErrorHandler
strFileName = "NoodleReview.xls"
strFilePath = "C:\Noodle!\"
strFileAndPath = strFilePath & strFileName
strDataSource = "qryDataTableReview"
Dim varReturn As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
'test for existence of NoodleReview folder and create if is not found
If Not fso.folderexists(strFilePath) Then
fso.createfolder strFilePath
End If
'Initialize the progress bar (using an arbitrary division of 4 units)
varReturn = SysCmd(acSysCmdInitMeter, _
"Creating output file ...", 4)
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 1)
'Delete old file, if there is one
If fso.FileExists(strFileAndPath) = True Then
fso.DeleteFile strFileAndPath
End If
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 2)
'Create new worksheet file in Noodle! folder
DoCmd.TransferSpreadsheet _
transfertype:=acExport, _
tablename:=strDataSource, _
FileName:=strFileAndPath, _
hasfieldnames:=True
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 3)
'Test for existence of worksheet file with loop to allow some time to
create the file
For i = 1 To 100
If fso.FileExists(strFileAndPath) = False Then
i = i + 1
GoTo TryAgain
End If
TryAgain:
Next i
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 4)
'message to user
MsgBox "Worksheet created as " & strFileAndPath, vbOKOnly +
vbInformation, "Done"
ErrorHandlerExit:
'Remove the progress bar
varReturn = SysCmd(acSysCmdRemoveMeter)
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & _
Err.Description
Resume ErrorHandlerExit
End Sub
manipulate folders and files in an Access procedure. In XP (from the Access
File menu), when I try to rename a file, copy/paste a file, or delete a file,
the directory screen doesn't immediately refresh. I have to close and reopen
the XP File directory to see the changes. This began occurring since I
implemented the following code using the Scripting.FileSystemObject. Any
ideas? Thanks.
Public Sub cmdTransferToExcel_Click()
Dim fso As Scripting.FileSystemObject
Dim strFileName As String
Dim strFilePath As String
Dim strFileAndPath As String
Dim strDataSource As String
Dim i As Integer
On Error GoTo ErrorHandler
strFileName = "NoodleReview.xls"
strFilePath = "C:\Noodle!\"
strFileAndPath = strFilePath & strFileName
strDataSource = "qryDataTableReview"
Dim varReturn As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
'test for existence of NoodleReview folder and create if is not found
If Not fso.folderexists(strFilePath) Then
fso.createfolder strFilePath
End If
'Initialize the progress bar (using an arbitrary division of 4 units)
varReturn = SysCmd(acSysCmdInitMeter, _
"Creating output file ...", 4)
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 1)
'Delete old file, if there is one
If fso.FileExists(strFileAndPath) = True Then
fso.DeleteFile strFileAndPath
End If
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 2)
'Create new worksheet file in Noodle! folder
DoCmd.TransferSpreadsheet _
transfertype:=acExport, _
tablename:=strDataSource, _
FileName:=strFileAndPath, _
hasfieldnames:=True
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 3)
'Test for existence of worksheet file with loop to allow some time to
create the file
For i = 1 To 100
If fso.FileExists(strFileAndPath) = False Then
i = i + 1
GoTo TryAgain
End If
TryAgain:
Next i
'Update the progress bar
varReturn = SysCmd(acSysCmdUpdateMeter, 4)
'message to user
MsgBox "Worksheet created as " & strFileAndPath, vbOKOnly +
vbInformation, "Done"
ErrorHandlerExit:
'Remove the progress bar
varReturn = SysCmd(acSysCmdRemoveMeter)
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & _
Err.Description
Resume ErrorHandlerExit
End Sub