[[20210415103945]]　『Excel VBAで特定フォルダに格納されているファイメx（バロック）　ページの最後に飛ぶ

『Excel VBAで特定フォルダに格納されているファイルを読み込む』（バロック）

　下記のようなVBAを作成して、得意先から毎週送られてくるバックオーダーのファイルをフォルダに保存してから別のシステムに取り込んで、今週の出荷数を決めるソフトを作成しています。

得意先ごとにソフトを分けて運用しているのですが、同じVBAの記述をしているのに1社だけ、フォルダに入れたファイルを読み込むVBAが作動しません。

私個人のPCでは、問題なく取り込めるのですが、得意先の環境に同システムを置いて同じ作業をすると取り込めないという現象が起きていて理由がわかりません。

それも6社のうち1社だけがそういう状態になっています。
お分かりになる方がいらっしゃいましたら、教えていただけないでしょうか？

尚、私も得意先もOffice365を使用しています。

 Public Sub NoguchiBO()

 Dim i As Long, j As Long, r As Long  'カウント用変数

 Dim myFld As String, myCri As String
 Dim myRow As Long

 Dim wsdata As Worksheet
 Set wsdata = SheetNoguchiBO 'データを入れるシートを指定する

 'ファイルパスの取得
 Dim strPath As Variant
 strPath = ThisWorkbook.Path & "\野口商会BOファイル\"

 'ファイルシステムオブジェクト変数の準備

 Dim objFSO As Object
 Set objFSO = CreateObject("Scripting.FileSystemObject")  
 'FileSystemObject

 Dim objFile As Object
 For Each objFile In objFSO.getfolder(strPath).Files

    With Workbooks.Open(fileName:=strPath & objFile.Name, ReadOnly:=False)

        With Worksheets("sheet1")

            Dim sht As Worksheet
            Set sht = Worksheets("sheet1")

            myRow = sht.Range("A" & Rows.Count).End(xlUp).Row

            j = wsdata.Cells(Rows.Count, 1).End(xlUp).Row
            wsdata.Range("A2:I" & j).Delete

            sht.Range("A2:I" & myRow).Copy
            wsdata.Cells(2, 1).PasteSpecial Paste:=xlPasteValues

            Application.DisplayAlerts = False
        End With
             .Close SaveChanges:=False

    End With

 Next objFile
            Application.DisplayAlerts = True
 MsgBox "BOリストを更新しました"
 End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 これは何かエラーが出ているのか、それともエラーも出ずに読み込みだけできていないのだろうか？
 あと、得意先の環境にあるEXCELは32ビット版か64ビット版どちらだろうか？
（ねむねむ） 2021/04/15(木) 11:03

 >Set wsdata = SheetNoguchiBO 'データを入れるシートを指定する
 この行の SheetNoguchiBO って何？
 いきなりの登場でなんなのか想像がつかない

 あと、
 > with Worksheets("sheet1")
 とか
 > Set sht = Worksheets("sheet1")
 とかの、Sheet1の親のブックをちゃんと指定すべき
（とおりすがり） 2021/04/15(木) 11:17

ねむねむ様
32ビット版だそうです。
マクロボタンを押すと「データリンクプロパティ」というポップアップ画面がいきなり立ち上がるそうです。
「接続のテスト」をクリックすると、「マイクロソフトデータリンクエラー」という別のポップアップが出てきます。画面を貼りつけられないので書いていることを要約すると、「プロバイダーの初期化中にエラーが発生したため、接続のテストに失敗しました。この操作はこの種類のIISAMではサポートされていません。この操作を実行するには、2007Microsoftofficesystem以前のバージョンを使用してください」と出ます。
当初、得意先の客先のファイルのバージョンが古いことが理由ではないかと思ったのですが。
私のPCではきちんとファイルが取り込めるので、どういうことなのかがわかりません。
得意先のサーバーが受け付けないのでしょうか？

とおりすがり様
SheetNoguchiBOというのは、Sheetの名前です。
万が一シート名を変更されてもプログラムが正常に動くようにしています。

ブックの名前は、「同じ名前+日付」形式で顧客から送られてくるので毎回違う名前になるため、ファイル名の指定ではなく、特定のフォルダに入っているファイルを指定しています。
ファイルの名前を毎回変更するひと手間を省くことで、クライアントの使い勝手を考えてのことです。
（バロック） 2021/04/15(木) 13:38

 >Sheet1の親のブックをちゃんと指定すべき
 と
 >ファイルの名前を毎回変更するひと手間を省く
 は全く関係なくて、両立する。

 開いたファイルが　sheet1 の親だとすれば、

 With Workbooks.Open(fileName:=strPath & objFile.Name, ReadOnly:=False)
   With .Worksheets("sheet1")
     Set sht = .Worksheets("sheet1")
 でよい話

 今のコードでは、Withステートメントを使っている意味が全くない
（とおりすがり） 2021/04/15(木) 15:36

とおりすがり様

教えていただきありがとうございます。
教えていただいたコードにした場合、取り込めない状態になっている1社のファイルが取り込めるようになりますか？
私のPCでは問題なく取り込めるので、テストができません。
コードを変更して、それが可能になるのでしたら検証を依頼したいと思います。
（バロック） 2021/04/15(木) 16:23

 >教えていただいたコードにした場合、取り込めない状態になっている1社のファイルが取り込めるようになりますか？

 ならないでしょう
 エラーの原因とは関係ないです。

 データリンクプロパティで検索したところ、
 Excelで、Thumbs.db　というファイルを開こうとするとそのような現象になるようです。

 ・エクセルのマクロファイルの同じフォルダの Thumbs.db を削除する
 ・Workbooks.Openで objFile をオープンする前に拡張子を調べて、エクセルのファイルだけを開く
 ようにすればいいです
（とおりすがり） 2021/04/15(木) 16:42

コメント返信：

[ 一覧(最新更新順) ]

[[20210415103945]] 『Excel VBAで特定フォルダに格納されているファイメx（バロック） ページの最後に飛ぶ

[[20210415103945]]　『Excel VBAで特定フォルダに格納されているファイメx（バロック）　ページの最後に飛ぶ