Excel VBA効率的にファイル名を取得する機能


8

Excel 2007のVBAを使用してリモートサーバー上のフォルダからファイル名のコレクションを取得する必要があります。機能し、ほとんどの場合、しかし、リモートサーバーは頻繁にひどい、ひどいネットワークパフォーマンスの問題があります。つまり、300個のファイルをループに入れてコレクションに名前を付けるには10分かかります。フォルダ内のファイル数は数千に増える可能性があります。これは実行できません。ファイル名をすべて取得する方法が必要です単一のネットワーク要求ではなくループします。私は時間がかかるので、1つの要求が1つのパスですべてのファイルをかなり迅速に取得できるようにする必要があるリモートサーバーへの接続を信じています。

これは、私は、現在の場所に持っている機能である:

Private Function GetFileNames(sPath As String) As Collection 
'takes a path and returns a collection of the file names in the folder 

Dim oFolder  As Object 
Dim oFile  As Object 
Dim oFSO  As Object 
Dim colList  As New Collection 

Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oFolder = oFSO.GetFolder(folderpath:=sPath) 

For Each oFile In oFolder.Files 
    colList.Add oFile.Name 
Next oFile 

Set GetFileNames = colList 

Set oFolder = Nothing 
Set oFSO = Nothing 

End Function 
  0

+ 1良い質問:)あなたはほとんど私の考えを持っていました! 08 10月. 142014-10-08 18:13:34

0

[OK]を、私は私の状況のた​​めに働くと、おそらく他の人があまりにもそれが便利になる解決策を発見しました。このsoutionは、Windows APIを使用し、1秒以内にファイル名を取得します。ここでは、FSOメソッドが数分かかっています。それはまだループを含んでいるので、なぜそれがずっと速いのかはわかりませんが、それはそうです。

"c:\ windows \"のようなパスをとり、そのフォルダ内のすべてのファイル(およびディレクトリ)のコレクションを返します。私が使用した正確なパラメータには、Windows 7以降が必要です。宣言のコメントを参照してください。

'for windows API call to FindFirstFileEx 
Private Const INVALID_HANDLE_VALUE = -1 
Private Const MAX_PATH = 260 

Private Type FILETIME 
    dwLowDateTime As Long 
    dwHighDateTime As Long 
End Type 

Private Type WIN32_FIND_DATA 
    dwFileAttributes As Long 
    ftCreationTime  As FILETIME 
    ftLastAccessTime As FILETIME 
    ftLastWriteTime  As FILETIME 
    nFileSizeHigh  As Long 
    nFileSizeLow  As Long 
    dwReserved0   As Long 
    dwReserved1   As Long 
    cFileName   As String * MAX_PATH 
    cAlternate   As String * 14 
End Type 

Private Const FIND_FIRST_EX_CASE_SENSITIVE As Long = 1 
'MSDN: "This value is not supported until Windows Server 2008 R2 and Windows 7." 
Private Const FIND_FIRST_EX_LARGE_FETCH  As Long = 2 

Private Enum FINDEX_SEARCH_OPS 
    FindExSearchNameMatch 
    FindExSearchLimitToDirectories 
    FindExSearchLimitToDevices 
End Enum 

Private Enum FINDEX_INFO_LEVELS 
    FindExInfoStandard 
    FindExInfoBasic 'MSDN: "This value is not supported until Windows Server 2008 R2 and Windows 7." 
    FindExInfoMaxInfoLevel 
End Enum 

Private Declare Function FindFirstFileEx Lib "kernel32" Alias "FindFirstFileExA" (_ 
ByVal lpFileName As String, ByVal fInfoLevelId As Long, lpFindFileData As WIN32_FIND_DATA, _ 
    ByVal fSearchOp As Long, ByVal lpSearchFilter As Long, ByVal dwAdditionalFlags As Long) As Long 
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (_ 
    ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long 
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long 


Private Function GetFiles(ByVal sPath As String) As Collection 

    Dim fileInfo As WIN32_FIND_DATA 'buffer for file info 
    Dim hFile  As Long    'file handle 
    Dim colFiles As New Collection 

    sPath = sPath & "*.*" 

    hFile = FindFirstFileEx(sPath & vbNullChar, FindExInfoBasic, fileInfo, FindExSearchNameMatch, 0&, FIND_FIRST_EX_LARGE_FETCH) 

    If hFile <> INVALID_HANDLE_VALUE Then 
     Do While FindNextFile(hFile, fileInfo) 
      colFiles.Add Left(fileInfo.cFileName, InStr(fileInfo.cFileName, vbNullChar) - 1) 
     Loop 

     FindClose hFile 
    End If 

    Set GetFiles = colFiles 

End Function 

0

私はループせずに私のディレクトリ内のファイル名を得ることができるが、それを見つけることができなかったAPIがあるだろうと思いました。私が知っているすべてのコードは、fsoまたはdirのいずれかを使用してループします。

したがって、ループを起こさずにファイル名を取得することは可能です。私推測するはい...ここでは、DOSプロンプト、ファイル全体の構造における以下のコマンドを入力すると

行うテキストファイル

Dir C:\Temp\*.* > C:\Temp\MyFile.Txt 

に送信されます私は考えることができる一つの方法は...ありますVBA

Sub Sample() 
    Dim sPath As String 

    sPath = "C:\Temp\" 

    '~~> DIR C:\Temp\*.* > C:\Temp\MyFile.txt 
    retval = Shell("cmd.exe /c Dir " & sPath & "*.* > " & sPath & "MyFile.Txt") 
End Sub 

から上記例えば(これがMYFILE.TXTに格納されているものである)

Volume in drive C is XXXXXXX 
Volume Serial Number is XXXXXXXXX 

Directory of C:\Temp 

10/08/2014 11:28 PM <DIR>   . 
10/08/2014 11:28 PM <DIR>   .. 
10/08/2014 11:27 PM    832 aaa.txt 
10/08/2014 11:28 PM     0 bbb.txt 
10/08/2014 11:26 PM     0 New Bitmap Image.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_2.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_2_2.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_3.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_3_2.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_4.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_4_2.bmp 
10/08/2014 11:26 PM     0 New Bitmap Image_5.bmp 
      10 File(s)   832 bytes 
      2 Dir(s) 424,786,952,192 bytes free 

だから今全てのYあなたがする必要があるのは、テキストファイルをリモートフォルダからあなたのフォルダにコピーし、それを単に解析してファイル名を得ることです。この関数を呼び出す

Sub filesTest() 
    Dim x() As String 
    x = Function_FileList("YOUR_PATH_AND_FOLDER_NAME") 
    Debug.Print Join(x, vbCrLf) 
    End Sub 

  0

これは引き続きローカルマシンから 'dir'コマンドを実行し、ネットワーク経由でファイルリストを要求します。 'cmd.exe'を介してそれを実行することはまだそれをローカルで実行します。バッチファイルやスクリプトをネットワーク経由でコピーし、 'rexec'などを使ってリモートで実行し、そのリモートプロセスが終了したらネットワーク経由で結果ファイルを転送する必要があります。それが完了するために)。 08 10月. 142014-10-08 18:32:38

  0

真実ですが、これはOPが当面持つ唯一のオプションだと思いますか? 08 10月. 142014-10-08 18:33:47

  0

これは改善されません。:-) 'rexec'を介してファイルを起動し、ポーリングしてからテキストファイルを転送した後、テキストファイルを解析してファイルリストを取得するオーバーヘッドは、パフォーマンスに影響します。 08 10月. 142014-10-08 18:35:25

  0

私はちょうど考えを持っていました...ローカルマシンからcmdを実行しないように(そのマシンの)cmdの完全なパスを与えるとどうなりますか? 08 10月. 142014-10-08 18:39:04

  0

動作しません。 cmdは引き続きローカルマシン上で実行されます。リモートマシン上で実行するには、ローカルマシンではなくリモートマシン上で*実際に実行する必要があります。ローカルマシンからリモートパスを使用して実行すると、ローカルOS上で実行するためにアプリケーション全体(cmd.exe)が取得されます。 08 10月. 142014-10-08 18:53:56

  0

ああ私はそれを知らなかった。 08 10月. 142014-10-08 18:55:12

  0

@SiddharthRout:これに感謝しますが、私はCMDを使うことはできません。上記の答えに私のコメントを見てください。 08 10月. 142014-10-08 19:04:10


8

この1つは超高速です

Function Function_FileList(FolderLocation As String) 
    Function_FileList = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & FolderLocation & """ /b /a-d").stdout.readall, vbCrLf), ".") 
End Function 
+2

+1シンプルに美しい! 08 10月. 142014-10-08 18:20:58

  0

ネットワーク接続が遅い場合や、たくさんのファイルがある場合は、それ以上のスピードではありません。 'dir'は内部的に反復し、' exec 'を通して実行すると、ローカルマシン上で実行され、同じネットワーク待ち時間に陥ります。 08 10月. 142014-10-08 18:22:27

  0

@KenWhite上記のコードをバッチファイルに入れ、そのファイルをリモートフォルダにコピーしてそこから実行するとどうなりますか? 08 10月. 142014-10-08 18:24:58

+1

@SiddharthRout: 'rexec'などを使用しない限り、ローカルマシン上で実行され、ネットワーク経由でリストを取得します。問題は、リモートマシン上でプロセスを実行してファイルを転送することではなく、それは反復せずにディレクトリリストを検索することであり、それは単に不可能です。 (Raymond Chenは、低速ネットワーク接続を介してファイルリストを取得するエクスプローラに関連して、この問題に関する一連の記事を書いたが、私はそれらに便利なリンクを持っていない) 08 10月. 142014-10-08 18:28:21

  0

@KenWhite:うーん、リモートフォルダー内のリストをテキストファイルに出力した後、そのテキストファイルを取得しますか? 08 10月. 142014-10-08 18:31:18

  0

@SiddharthRout:あなたの答えに私のコメントを見てください。 :-) 08 10月. 142014-10-08 18:33:11

  0

@tbur:これは興味深いアプローチですが、パフォーマンスを比較するためにテストするのが大好きですが、CMDやユーザーアカウントのホワイトリストにない実行可能ファイルは呼び出せません。私は関数を実行しようとしましたが、実行時エラー "このプログラムはグループポリシーによってブロックされています"が表示されます。すべてのソリューションは、オフィスオブジェクトモデル、VBA、または既に存在するCOMライブラリに限定する必要があります。 08 10月. 142014-10-08 19:01:38