Search directory

[LeAnn]

I am using Access 2003 (2000 format) and Excel 2003. I have a procedure
that:
1) imports all text files in a particular directory into Excel; 2) copies a
specific range into a different Excel template; 3) closes the imported file
without saving; and saves template with the copied range into a different
directory. Everything works fine but we discovered that it’s possible to
have the final file name duplicated and windows over writes the first file.
I would like to search the destination directory (different from #1) for the
existence of the file and if found do something else with the second file for
investigation. My code is below. How could I search the UDLOCDIR
directory for the existence of UDLOCDIR & strBox & ".xls" before saving?

Thanks
LeAnn

**********************
Sub cmdSCN_Click()

'Set the environment and variables
Dim lngLFile As Long, strLFile As String 'FreeFile number for
log, Log File name
Dim strFile As String 'File name
Dim objApp As Object 'Excel Application
Dim objBook As Object, objBook2 'Excel Workbooks
Dim objSheet As Object, objSheet2 'Excel Worksheets
Dim lngCount As Long 'Loop counter
Dim strBox As String ‘Box name – first unit in file

On Error GoTo ErrorHandler:

'Create the import log
lngLFile = FreeFile
Open UDLOGDIR & "SCN_LOG" & Format(Now, "mmddyyhhmmss") & ".txt" For Output
As lngLFile
Print #lngLFile, "Convert SCN files"
Print #lngLFile, "Processed By: " & strUName
Print #lngLFile, "Processed Files:"

'For each Sample Locator excel file in the directory do the following:
strFile = Dir(UDSCNDIR) 'return first file name in
the process directory

If strFile = "" Then
MsgBox "There are no files in the SCN directory.", vbOKOnly +
vbExclamation, "Error"
Print #lngLFile, "No files found in directory"
Close
Reset
Exit Sub
End If

lngCount = 0

'Import the *.scn files and copy unit range into locator template
Do Until strFile = ""

'Open excel
Set objApp = CreateObject("Excel.Application")
objApp.DisplayAlerts = False

objApp.Workbooks.OpenText Filename:=UDSCNDIR & strFile, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1,
2), _
TrailingMinusNumbers:=True

Set objSheet = objApp.Worksheets(1)
objSheet.Range("A25").Select
objSheet.Range("A25:A280").Select
objApp.Selection.Copy

'Open Locator template and paste selection in cell D2

Set objBook2 = objApp.Workbooks.Open(UDSLOCATOR)

Set objSheet2 = objBook2.Worksheets(1)

objSheet2.Range("D2").Select
objSheet2.Paste
strBox = objSheet2.Range("A2").Value
objSheet2.Range("A1").Select
objBook2.SaveAs UDLOCDIR & strBox & ".xls"

Print #lngLFile, strFile
strFile = Dir
lngCount = lngCount + 1
objBook2.Close
Loop

Print #lngLFile, vbCr & vbCr & lngCount & " SCN Files processed."
MsgBox lngCount & " SCN Files processed. Please check the directory below:"
& Chr(10) & Chr(10) & UDLOCDIR

Exit_Sub:
Close
Reset
objApp.Quit
Set objSheet = Nothing
Set objSheet2 = Nothing
Set objBook2 = Nothing
Set objApp = Nothing
Exit Sub

ErrorHandler:
MsgBox "Error #" & Err.Number & " - Description: " & Err.Description,
vbOKOnly + vbExclamation, "Error"
Resume Exit_Sub
End Sub

 

[Alex Dybenko]

Hi,
you can use:
if len(dir(UDLOCDIR & strBox & ".xls"))>0 then
'file exists
end if

 

[LeAnn]

Thanks Alex. I tried your idea but I get a run time error on the line:
strFile = Dir

The error is "Run-Time Error 5: Invalid Procedure call or argument"

Since I used strFile = Dir(UDSCNDIR) earlier, and use it again as in your
suggestion, I suspect the strFile = Dir is looking in the destination
folder and there is only 1 file there after the first loop. I’m thinking the
solution to this would be to change strFile = Dir to strFile =
Dir(UDSCNDIR) to redirect it back to the original directory. The only issue
is that that statement only looks at the first file and so it is stuck in a
loop. I have modified the code as follows to kill the file that was
processed but I now get a “Permission denied†because the text file is still
open in memory. I added ojbBook2.close and objApp.Quit but it isn’t working.
Any suggestions?

strBox = objSheet2.Range("A2").Value
objSheet2.Range("A1").Select

'check to see if the file name is a duplicate
If Len(Dir(UDLOCDIR & strBox & ".xls")) > 0 Then
objBook2.SaveAs UDDUPDIR & strBox & ".xls"
lngDup = lngDup + 1
Else
objBook2.SaveAs UDLOCDIR & strBox & ".xls"
End If

Print #lngLFile, strFile
objBook2.Close
objApp.Quit
Kill UDSCNDIR & strFile

strFile = Dir(UDSCNDIR)

 

[Alex Dybenko]

Hi,
dont understand why you use strFile = Dir.

How could I search the UDLOCDIR directory for the existence of UDLOCDIR &
strBox & ".xls" before saving?

so you check if file exist:

If Len(Dir(UDLOCDIR & strBox & ".xls")) > 0 Then

'Here you perhaps to delete file:
kill UDLOCDIR & strBox & ".xls"

objBook2.SaveAs UDDUPDIR & strBox & ".xls"
lngDup = lngDup + 1
Else
objBook2.SaveAs UDLOCDIR & strBox & ".xls"
End If

also you can check if Kill produce an error (no permission, file is opened)
and then give a message to user.
BTW, this is better to check before you create your excel sheet

--
Alex Dybenko (MVP)
http://alexdyb.blogspot.com
http://www.PointLtd.com

 

[LeAnn]

It is used to loop through a directory to get the next file. I have multiple
files to to process. Using:

If Len(Dir(UDLOCDIR & strBox & ".xls")) > 0 Then

to check a different directory is interferring with the original loop needed
to process those files. Is there another way to do this and still check the
destination directory before saving the processed file?

 

[Alex Dybenko]

if strBox has a wildcard characters, then you can use strFile = Dir in a
loop to get all files which are match. once contain non zero length string -
then it return a filename, which of course exists

HTH

 

[LeAnn]

I'm sorry, I didn't read your entire post before. I don't want to kill the
destination file. I want to kill the source file after it is processed but I
can't because I'm not releasing the objects correctly. If there is a
duplicate file in the destination I want to save the duplicate to a different
directory. It's better to check what before I create my excel sheet? I
don't think I can because the name of the destination file comes from one of
the cells in the sheet. I think if I release my objects correctly, this
would work. Any suggestions? Or, if all of the source files have *.scn can
I write my loop differently? Should I set strFile different and use a For
each loop?

Thanks for your assistance.

 

[Alex Dybenko]

hi,
i think in this case you better first save excel file, close excel and then
delete source file.

It's better to check what before I create my excel sheet?

i thought that you overwrite file, if not - then this does not matter

 

[LeAnn]

Ok, I tried to save the test file which was opened with the OpenText method
but I get an error: 1004 - Cannot access read only document
'3358SEP203102121.scn'.
I modifed the code:

Set objApp = CreateObject("Excel.Application")
objApp.DisplayAlerts = False

objApp.Workbooks.OpenText FileName:=UDSCNDIR & strFile, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1,
2), _
TrailingMinusNumbers:=True

Set objSheet = objApp.Worksheets(1)
'New statement below caused the error
objApp.ActiveWorkbook.SaveAs UDSCNDIR & strFile


I'm running out of hope that we can solve this issue. Can you be more
specific with the code I should use and where to release this object so I can
kill it?

Thanks
LeAnn

 

[Alex Dybenko]

Hi,
please post all your code, belong to this proc, here, else it is quite
difficult to find where the problem is

 

[LeAnn]

Well, I came up with a different solution. Basically, I will process the
source files and save them under their original file names in the destination
folder. Then I import those files into the database. I wrote code to check
for duplicates in that procedure and if so, moved that file to a "dup" folder.

Thanks for all your assistance.
LeAnn