omnibuster
05-20-2009, 12:47 PM
In Folder File excist, but code say: NOT Excist!
Why ? What i do wrong?:banghead:
Sub ContrBookS() '
Dim fso As Object, fld As Object, Fil As Object
Dim SubFolderName As String, FilePath
Dim LastRow As Long
Dim i As Integer
Dim WB As Workbook, fName As String
Sheets("Sheet1").Select
LastRow = Range("A1").End(xlDown).Row
For i = 1 To LastRow
Range("A" & i).Activate
fName = Range("A" & i) & ".xls"
Set fso = CreateObject("Scripting.FileSystemObject")
SubFolderName = ThisWorkbook.Path
FilePath = ActiveWorkbook.Path
Set fld = fso.GetFolder(SubFolderName)
' For Each Fil In fld.Files
If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
' If fName <> ActiveWorkbook.Name Then
If Not fso.FileExists(fld & fName) Then
Range("A" & i).Offset(0, 1).Activate
ActiveCell.Value = 0
MsgBox fld & "\" & fName & " does not exist!", vbExclamation, "Source File Missing"
Else
If fso.FileExists(fld & fName) Then
' fso.MoveFile (fld & fName), fld
Set WB = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
'Do...
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
' Next Fil
Next i
End Sub
Why ? What i do wrong?:banghead:
Sub ContrBookS() '
Dim fso As Object, fld As Object, Fil As Object
Dim SubFolderName As String, FilePath
Dim LastRow As Long
Dim i As Integer
Dim WB As Workbook, fName As String
Sheets("Sheet1").Select
LastRow = Range("A1").End(xlDown).Row
For i = 1 To LastRow
Range("A" & i).Activate
fName = Range("A" & i) & ".xls"
Set fso = CreateObject("Scripting.FileSystemObject")
SubFolderName = ThisWorkbook.Path
FilePath = ActiveWorkbook.Path
Set fld = fso.GetFolder(SubFolderName)
' For Each Fil In fld.Files
If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
' If fName <> ActiveWorkbook.Name Then
If Not fso.FileExists(fld & fName) Then
Range("A" & i).Offset(0, 1).Activate
ActiveCell.Value = 0
MsgBox fld & "\" & fName & " does not exist!", vbExclamation, "Source File Missing"
Else
If fso.FileExists(fld & fName) Then
' fso.MoveFile (fld & fName), fld
Set WB = Workbooks.Open(FilePath & fName, UpdateLinks:=0)
'Do...
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
' Next Fil
Next i
End Sub