【無料配信♪】Renta !全タテコミ作品第1話

完全な初心者でいろいろ調べたのですがわからないので教えて下さい。
サブフォルダー内のPDFファイルのみを別フォルダにコピーするVBAを
ご教示ください。お願いします。

質問者からの補足コメント

  • 説明が悪くて申し訳ありません。
    Aフォルダ内にB,C,D,E,F,,,,,,とサブフォルダーがあり、各サブフォルダー内に様々な種類のファイルがあるところ、その中のPDFファイルのみをZフォルダーにコピーしたいものです。

      補足日時:2016/10/29 19:26

このQ&Aに関連する最新のQ&A

A 回答 (5件)

No.3です。



CドライブのAフォルダの中のサブフォルダ内のPFDファイルを、CドライブのZフォルダにコピーするように変更しました。

Sub Sample()
Const fpath1 As String = "C:\A\"
Const fpath2 As String = "C:\Z\"
Dim fso As Object
Dim subfpath As String
Set fso = CreateObject("Scripting.FileSystemObject")
subfpath = Dir(fpath1, vbDirectory)
Do Until subfpath = ""
If subfpath <> "." And subfpath <> ".." Then
fname = fpath1 & subfpath & "\*.pdf"
fso.CopyFile fname, fpath2
End If
subfpath = Dir()
Loop
Set fso = Nothing
End Sub
    • good
    • 3
この回答へのお礼

完璧なご回答まことにありがとうございました。

お礼日時:2016/10/29 22:04

こんにちは。



'コマンドプロンプトで。

Sub TestCopy()
'コピー元
Const SOURCE As String = "C:\Temp\Test1\"
'コピー先
Const DESTIN As String = "C:\Temp\Test2\"
Dim strCMD As String

strCMD = "Cmd /c copy /-y " & SOURCE & "*.pdf " & DESTIN
'/-y は、上書き確認
Shell strCMD

End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました。

お礼日時:2016/10/29 22:04

サンプルです。



下記に元のフォルダを
Const fpath1 As String = "D:\Data\"

下記にコピー先のフォルダを
Const fpath2 As String = "D:\Data\Work\"

それぞれ指定して下さい。最後に \ をつけるのを忘れないように。


Sub Sample()
Const fpath1 As String = "D:\Data\"
Const fpath2 As String = "D:\Data\Work\"
Dim fname As String
fname = Dir(fpath1 & "*.pdf", vbNormal)
Do Until fname = ""
FileCopy fpath1 & fname, fpath2 & fname
fname = Dir()
Loop
End Sub
    • good
    • 0

あ、ごめん。


忘れて。
    • good
    • 0

VBAでもいいですけど、バッチの方が手軽ですよ

    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QVBAで別エクセルファイルから指定エクセルファイルにシートをコピー

Office2003のエクセルでVBAを勉強しております。

そこで、VBAで別エクセルファイルからあるシートを指定エクセルファイルへ丸まるコピーしたい場合にはどのようにすればよいのでしょうか?

Aベストアンサー

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)


>Office2003のエクセルでVBAを勉強しております。

方法が解らなければ、記録マクロを確認するのが一番です。
動作が理解出来たら、コードの最適化を行ってください。

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qフォルダ内のファイルを取得し別ディレクトリへコピーしたい

Windowであるフォルダ内の全てのファイルを取得して、別のディレクトリのフォルダへコピーしたいです。

バッチコマンドでできれば一番いいのですが、そんな機能をもっているコマンドはないみたいなので、VBスクリプトでも構いません。

いい方法ないでしょうか?

Aベストアンサー

'PDFファイルがあるフォルダ名
strBasePath = "C:\Box"
'コピー先のフォルダ名(このサブフォルダに6桁のフォルダ名が自動作成される)
strCopyPath = "C:\Box"
Call CustomCopyFile(strBasePath,strCopyPath)

'処理ルーチン
Sub CustomCopyFile(BasePath,CopyPath)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(BasePath)
'ファイル名の検索
For Each objFile In objFolder.Files
strFolder = Left(objFile.Name,6)
strCreate = CopyPath & "\" & strFolder
strFname = objFolder.Path & "\" & objFile.Name
'フォルダ自動作成
If Not objFS.FolderExists(strCreate) Then
objFS.CreateFolder(strCreate)
End If
'コピー処理
objFS.CopyFile strFname, strCreate & "\"
Next
End Sub

'PDFファイルがあるフォルダ名
strBasePath = "C:\Box"
'コピー先のフォルダ名(このサブフォルダに6桁のフォルダ名が自動作成される)
strCopyPath = "C:\Box"
Call CustomCopyFile(strBasePath,strCopyPath)

'処理ルーチン
Sub CustomCopyFile(BasePath,CopyPath)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(BasePath)
'ファイル名の検索
For Each objFile In objFolder.Files
strFolder = Left(objFile.Name,6)
strCreate = CopyPath & "\" & strFo...続きを読む

Qサブフォルダ内のファイルを全部移動させたい。

VBScriptのバッチでの作成を考えています。

あるフォルダ(名をFolderとします)の中に、たくさんのサブフォルダが
あって、そこにあるファイルをすべてFolderに移動させたいと
思っています。
(ファイルはjpg画像ファイルだけです。)

たとえば、Folderの下に、Folder_Bというサブフォルダがあって、
更にその下にFolder_Cがあり、その中には1.jpgというファイルが
あったとしたら、バッチ実行後、Folderの直下に1.jpgがあり、
(可能であれば)フォルダはすべて消えているという具合です。

ファイルの移動自体はファイルシステムオブジェクトのFile.Moveで行い、
最後にディレクトリを列挙して削除していけばいいんだろうなという
ところはわかります。
しかし、フォルダをサブフォルダも含めてすべて舐めて、そこから
ファイルを移動していくというロジックに悩んでいます。

アドバイスいただけないでしょうか。

Aベストアンサー

この手のコードは 「FileSystemObject 再帰」 のキーワードでググればたくさんサンプルが見つかる。

Excel VBA の標準モジュールなどでステップ実行すると動きを確認できる。
ロジックとしては、、、
サブフォルダーが存在しなくなる最深フォルダーまで潜る。
そのフォルダーにあるファイル群を移動させる。
1階層上のフォルダーに戻る。
先ほどのフォルダーを削除する。
ってのを再帰処理で行う。

Const rootPath = "E:\test\"
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim rootDir
Set rootDir = fso.GetFolder(rootPath)

Call MoveFiles(rootDir)


' 引数としてフォルダー オブジェクトをもらう
Sub MoveFiles(aDir)
  ' 引数で得たフォルダー内にサブフォルダーがあれば再帰する。
  Dim subDir
  For Each subDir In aDir.SubFolders
    Call MoveFiles(subDir) ' サブフォルダーで再帰処理
    subDir.Delete ' 戻ってきたら (フォルダー内が空であるはずなので) フォルダーを削除する
  Next

  ' 引数で得たフォルダー内のファイル群を移動させる。
  Dim f
  For Each f In adir.Files
    f.Move(rootPath)
  Next
End Sub

この手のコードは 「FileSystemObject 再帰」 のキーワードでググればたくさんサンプルが見つかる。

Excel VBA の標準モジュールなどでステップ実行すると動きを確認できる。
ロジックとしては、、、
サブフォルダーが存在しなくなる最深フォルダーまで潜る。
そのフォルダーにあるファイル群を移動させる。
1階層上のフォルダーに戻る。
先ほどのフォルダーを削除する。
ってのを再帰処理で行う。

Const rootPath = "E:\test\"
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim rootDir
Set ...続きを読む

QExcelのVBAでフォルダ指定ができるダイアログボックスを出す方法

指定したフォルダに自動でExcelファイルを保存できるようにしたいのですが、フォルダ指定ができるダイアログボックスはないのでしょうか?ファイルを指定するダイアログボックスはできるのですが、それでは必ずファイルを選択しないといけないので・・・
指定できる方法が見つかりません。何か良い方法はないでしょうか?よろしくお願い致します。

Aベストアンサー

日が経ってしまったので既に解決されているかもしれませんが、
私も同じことをしたくて調べていたところ方法が分かったので参考までにと思い投稿いたしました。

次のサンプルコードを試してみてください。

Sub TEST()

Dim ShellApp As Object
Dim oFolder As Object
Set ShellApp = CreateObject("Shell.Application")
Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)

MsgBox oFolder.items.Item.Path, vbOKOnly, "フルパス表示!"

End Sub

APIなど使用せずともフォルダ指定ダイアログが表示可能です。
楽チンですね。

この「BrowseForFolder()メソッド」の詳しいプロパティ・メソッドの解説は参考URLを参照してください。
色々な使い方が可能です。
http://www.galliver.co.jp/writing/susume_vb/tre904/

参考URL:http://www.galliver.co.jp/writing/susume_vb/tre904/

日が経ってしまったので既に解決されているかもしれませんが、
私も同じことをしたくて調べていたところ方法が分かったので参考までにと思い投稿いたしました。

次のサンプルコードを試してみてください。

Sub TEST()

Dim ShellApp As Object
Dim oFolder As Object
Set ShellApp = CreateObject("Shell.Application")
Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)

MsgBox oFolder.items.Item.Path, vbOKOnly, "フルパス表示!"

End Sub

APIなど使用せずともフォ...続きを読む

QエクセルVBAで、PDFファイルを開きたい

セルに入力した値のブック(xls)を開く場合、
以下となりますが、↓

Sub セルに入力したブック名のブックを開く()
ブック名 = Cells(1, 2) 'B1セルの値を取り出す
Workbooks.Open Filename:=ブック名 & ".xls" '指定されたブックを開く
End Sub


これでPDFファイルを開きたいです。
記述をどうしたらよいでしょうか。
目的はPDFファイルの検索/照会をxlsにてしたいのです。
お手数ですがお願いいたします。

Aベストアンサー

案1
ハイパーリンクにしてしまう。

案2
PDFファイルへのフルパスが、B列に記述してある
拡張子PDFへの関連付けがAcrobat Reader にしてある
と仮定して
ワークシートのイベントに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target.Value, "pdf") > 0 Then
  Call Shell("explorer.exe " & Target.Value)
  Cancel = True '編集モードキャンセル
End If
End Sub
とか?

PDFファイルが一箇所にまとまっているのなら
標準モジュールに
Sub test2()
Dim strFilePath As String
strFilePath = _
  Application.GetOpenFilename _
  ("PDFファイル,*.pdf", MultiSelect:=False)

If strFilePath = "false" Then
 Exit Sub
End If

Call Shell("explorer.exe " & strFilePath)

End Sub
でも?
ということかな?

案1
ハイパーリンクにしてしまう。

案2
PDFファイルへのフルパスが、B列に記述してある
拡張子PDFへの関連付けがAcrobat Reader にしてある
と仮定して
ワークシートのイベントに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target.Value, "pdf") > 0 Then
  Call Shell("explorer.exe " & Target.Value)
  Cancel = True '編集モードキャンセル
End If
End Sub
とか?

PDFファイルが一箇所にまとまっているのなら
標準モジュー...続きを読む

QExcelで○○を含むという条件にてvlookup処理(比較)できるでしょうか?

説明が難しいのですが、以下のようなAとBの2つのシートがありまして、BシートのA列にある条件がAシートのA列の歯抜の状態で入力されてます。これにBシートのB列に、AシートのB列を表示したいという状況があります。

具体的なイメージは、以下の通りです。

===========================================
Aシート
 A        B
1 山田真太郎 東京
2 鈴木波奈子 名古屋
3 斉藤ミツル 大阪
-------------------------------------------
Bシート
 A  
1 藤ミツ
2 奈子
3 田真太
===========================================


BシートのB列に関数などを利用して以下のように表示させたいです。
==========================================
 A     B
1 藤ミツ 大阪
2 奈子  名古屋
3 田真太 東京
==========================================

このように、「セルにある言葉を含む」という条件にて、Vlookupを使ったような計算式というのを組む事ができるでしょうか?

私が感じているBシートのB1に入れる関数イメージ
=VLOOKUP((*A1*),A!$A$1:$B$3,2)

何か良い方法があればご教授ください。

説明が難しいのですが、以下のようなAとBの2つのシートがありまして、BシートのA列にある条件がAシートのA列の歯抜の状態で入力されてます。これにBシートのB列に、AシートのB列を表示したいという状況があります。

具体的なイメージは、以下の通りです。

===========================================
Aシート
 A        B
1 山田真太郎 東京
2 鈴木波奈子 名古屋
3 斉藤ミツル 大阪
-------------------------------------------
Bシート
 A  
1 藤ミツ
2 奈子
3 田真...続きを読む

Aベストアンサー

NO2です。
因みに=VLOOKUP("*"&A1&"*",A!A:B,2,FALSE)でも可能ですのでお試しください。

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QエクセルVBAでフォルダ内の全ファイルをコピペ

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
よろしくお願いいたします。

フォルダ内にあるファイルの内、複数を指定して開いて、任意の部分をコピーし、マスターとなるファイルに貼りつける、という作業をVBAで行いたいと思っています。
VBAを全く知らないため、毎回20近いファイルを手で開いてはコピペしなくてはならず困っております。
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイ...続きを読む

Aベストアンサー

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペしたいです。
Sheets("Sheet1").Range("A1:J1000").Copy
の部分が Sheets("Sheet1").Range("A11:J1000").Copy
にすると、11行目からJ1000までに という事になります。
デーやが入っている最終の行を取得する方法はありますが、データを元データの行数がたいしたことなければ

元データが最大1000行までであれば
Range("A1:J1000").Copy
と指定しても、空白がコピーされるだけですので十分ではあります。

●マスターも同じく10行目まではタイトル欄なので、11行目以降に、他ファイルの11行目以降の内容をどんどん積み上げていく形式にしたいです。
Range("A65536").End(xlUp).Offset(1, 0).Select
がA列の最終の行から上へ検索してデータの入っている行の下を探しています。

●ファイルの名前は毎回変わるので、フォルダ内の指定されたエクセルファイルのみをコピペ、のような処理にしたいです。
Dir(Sheets("Sheet1").Range("A1").Value & "\*.xls")
で指定したフォルダのエクセルファイルを順に取得しています。

●B列だけは必ず記載がある列なので、そこを参考に11行目から何行目までをコピーすればいいのかを判断できるのかな、と思います。
Range("A65536").End(xlUp).Offset(1, 0).Select

Range("B65536").End(xlUp).Offset(1, 0).Select
とするとB列の最終行を取得できます。
*但し、B65536 はエクセル2003以前のヴァージョンの最大65536行なので、この様になっています。
エクセル2007以上であれば、 65536 の値が異なります。
バージョンを問わずという事であれば、最終の行を取得する方法があります。


●貼り付けが完了したらマスター以外の開いたファイルを全て閉じるところまで自動化できたら有難いです。
Workbooks(buf).Close SaveChanges:=False
の部分が、上書き保存せずに 閉じる という事です。
更に検討が必要な部分としては、貼り付けの作業を行った後のファイルをどうするかです。
そのままでは、VBAを実行するたびにデータが追加されますしね。
解決案
コピーが終了したら、ファイルごと削除、ほかのフォルダーへ移動させる。

或いは、
データの部分(11行目以下)を削除して保存していく。

或いは、
VBA実行前に、マスターのデータをクリアして、毎回、全てのファイルのデータを
貼り付ける。

とりあえず、ここまでにしておきます。

>全くの初心者なため、貼り付けるだけで動くようなものをいただけれると大変助かります。
そこまで甘えないことが上達の早道です。

同じような質問が良くありますよ。最近回答した質問ですが
http://oshiete.goo.ne.jp/qa/7578876.html
http://oshiete.goo.ne.jp/qa/4221547.html
を参考にしてみてください。とは云っても少し、説明しておきますと
●あるフォルダ内にあるファイルの形式は全て同じで、10行目まではタイトル欄になっているため、11行目以降の記載がある行だけをマスターとなるファイルにコピペし...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング