| |
▼tanaka さん：
おはようございます。
再現ができないので対処法が私にはわかりませんが、
>エラーメッセージは
>「実行時エラー'1004'
>'\\sst\??-\担当別\商品一覧表\八王子.xlsが見つかりません。ファイル名および
>ファイルの保存場所が正しいかどうか確認してください。
Fl.Pathで正しくパスが取得できていないという事ですね！！
因みに以下のコードではどうでしょうか？
'==========================================================
Sub main()
Dim nomvarray1() As String
Dim nomvarray2() As String
Dim nomvcnt1 As Long
Dim nomvcnt2 As Long
Dim fls As Object
Dim ret As Long
Dim foldnm As String
Dim fl As Object
Dim add As String
Dim bk As Workbook
Dim mes1 As String
Dim mes2 As String
Dim rcnt As Long
nomvcnt1 = 0: nomvcnt2 = 0
foldnm = "D:\My Documents\ＴＥＳＴエリア\testarea2002\testfold"
' 実際に検査するフォルダ名 ↑
Set fls = CreateObject("scripting.filesystemobject").GetFolder(foldnm).Files
For Each fl In fls
If UCase(fl.Name) Like UCase("*.xls") Then
'↑指定フォルダ内にあるExcelブックだったら？
ret = 1
Set bk = Workbooks.Open(foldnm & "\" & fl.name)
With bk
If .Worksheets("sheet1").Range("a1").Value = .Worksheets("sheet2").Range("c1").Value Then
With .Worksheets("sheet2").Range("c1:p1")
add = .Address(, , , True)
rcnt = .Count
End With
If Evaluate("SUM(COUNTIF(" & add & "," & add & "))") = rcnt Then
MsgBox bk.Name & " 転記処理を行う"
' 実際は、ここで転記処理を行う
Else
ReDim Preserve nomvarray2(1 To nomvcnt2 + 1)
nomvarray2(nomvcnt2 + 1) = .Name
nomvcnt2 = nomvcnt2 + 1
End If
Else
ReDim Preserve nomvarray1(1 To nomvcnt1 + 1)
nomvarray1(nomvcnt1 + 1) = .Name
nomvcnt1 = nomvcnt1 + 1
End If
.Close False
End With
End If
Next
If nomvcnt1 > 0 Or nomvcnt2 > 0 Then
If nomvcnt1 > 0 Then
mes1 = "1.A1とC1のNO.が一致していません" & vbCrLf & Join(nomvarray2(), vbCrLf)
End If
If nomvcnt2 > 0 Then
mes2 = "2.NO．が重複しています" & vbCrLf & Join(nomvarray1(), vbCrLf)
End If
MsgBox "転記しなかったブックは、" & vbCrLf & vbCrLf & mes1 & vbCrLf & vbCrLf & mes2
End If
Set fls = Nothing
Set fl = Nothing
End Sub
これでうまくいってしまうと、ますます現象の原因はわからなくなってしまいますが。
試してみてください。
|
|
ichinose
- 06/8/25(金) 7:34 -
