Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6236 / 76734 ←次へ | 前へ→

【76100】Re:ファイル名に指定された文字が含まれるファイルを集約したい
発言  kanabun  - 14/9/24(水) 16:56 -

引用なし
パスワード
   どうもFileCopy に時間がかかるようなので、
Windows APIの FileCopyOperation 使って Copyするサンプル書いてみました。
ウラ(画面の)でコピーしていると不安になるけど、コピーの情況が出るので、
同じ時間がかかっても安心できます(^^

'---------------------------------------------- 新しい標準モジュール
Option Explicit
Declare Function FileCopyOperation Lib "shell32.dll" Alias _
    "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    
Type SHFILEOPSTRUCT
  hwnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Boolean
  hNameMappings As Long
  lpszProgressTitle As String
End Type

Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_NOCONFIRMATION = &H10
Public Const FO_COPY = &H2

Public Sub opFileCopy(SrcFile As String, DestFile As String)
  Dim FT As SHFILEOPSTRUCT
  Dim ok As Long
  
  FT.hwnd = Application.hwnd
  FT.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
  FT.wFunc = FO_COPY
  FT.pFrom = SrcFile
  FT.pTo = DestFile
  
  ok = FileCopyOperation(FT)
    
End Sub

Private Function FileSearch(PathFilename As String, fData) As Long
  Dim tmpPath As String
  Dim sCmd As String
  Dim ok As Long
  
  tmpPath = Environ$("Temp") & "\Dir.tmp"  '一時ファイルパス
  sCmd = "DIR """ & PathFilename & """ /s /b > """ & tmpPath & """"
  ok = CreateObject("WScript.Shell") _
    .Run("%ComSpec% /C " & sCmd, 7, True) 'Dirコマンド実行

  If FileLen(tmpPath) > 0 Then
    Dim buf() As Byte
    Dim io As Integer
    io = FreeFile()
    Open tmpPath For Binary As io
     ReDim buf(1 To LOF(io))
     Get io, , buf
    Close io
    Kill tmpPath
    fData = Split(vbCrLf & StrConv(buf, vbUnicode), vbCrLf)
    FileSearch = UBound(fData) - 1
  End If
End Function

Sub Try3()
 Dim fData
 Dim i&, j&
 Dim n&
 Dim ss$
 Const TOP_FOLDER = "C:\Test1"
 Const COPY_TO = "C:\Test2"
 
 n = FileSearch(TOP_FOLDER & "\*a*.csv", fData)
 If n = 0 Then Exit Sub
 
 For i = 1 To n
   j = InStrRev(fData(i), "\")
   opFileCopy CStr(fData(i)), COPY_TO & Mid$(fData(i), j)
 Next

End Sub

3 hits

【76091】ファイル名に指定された文字が含まれるファイルを集約したい ペンネーム船長 14/9/23(火) 11:32 質問
【76092】Re:ファイル名に指定された文字が含まれる... カリーニン 14/9/23(火) 18:14 発言
【76093】Re:ファイル名に指定された文字が含まれる... カリーニン 14/9/23(火) 18:18 発言
【76095】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 12:08 発言
【76097】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 14:26 発言
【76100】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/24(水) 16:56 発言
【76103】Re:ファイル名に指定された文字が含まれる... ペンネーム船長 14/9/26(金) 0:50 お礼
【76104】Re:ファイル名に指定された文字が含まれる... kanabun 14/9/26(金) 1:16 発言

6236 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free