一貫性のあるBookの値を取得するツールを作ってみた

1 一貫性のあるBookの値を取得するツールを作ってみた
- 1.1 ツールの内容
- 1.2 共有:

この記事を書いた人
最新の記事

taka

あることがキッカケでVBAを独学で勉強しました、今ではブログを通してVBAでできることを解説しつつ、VBAや他の言語の勉強、ブログ運営の勉強をしています(^^♪

一貫性のあるBookの値を取得するツールを作ってみた

どうも、taka です( ^ω^ )今回はちょっと仕事で少し必要だったので作成した物をご紹介します(笑)

タイトルを見るとよくわからないとは思うのですが、先日仕事で同じフォーマットでExcel作られたファイルの中身がファイル名と間違っていないか(ファイル名が12月なのに11月の帳票など)を調べてほしいということで・・・

ファイル数は450ほど(;^ω^)こんなの一つ一つ調べることなんてできるわけがないのでツールを作成することにした次第です(;´･ω･)

まぁこんな特殊な経験する方は少ないと思いますが(笑)

ツールの内容

今回のツールの内容としては【フォルダー内のサブフォルダーの中のExcelファイルの値を抽出する】というものです(´・ω・`)

※もう一度言いますが【今回はサブフォルダーの中にあるExcelファイルの中身を取得する】です。フォルダー直下にあるファイルは取得しませんご注意ください。

コードはこんな感じになっています・・・汚いコードで申し訳ないです(/ω＼)

一応ダウンロードファイルを用意しました(;^ω^)

※このコードは超テキトーに作成したので参考程度にしておいてください(;^ω^)

Sub Sample()
Dim ofdFD As Office.FileDialog
Dim objFS As New FileSystemObject
Dim strPath As String
Dim FName As String
Dim cnt As Long
strPath = ThisWorkbook.Path 'このVBAコードのあるファイルのパスを指定
Set ofdFD = Application.FileDialog(msoFileDialogFolderPicker)
With ofdFD 'ダイヤログボックスの設定
'ダイヤログボックスのファイル表示の設定
.InitialView = msoFileDialogViewDetails
'複数選択をしないよう設定
.AllowMultiSelect = False
End With
Application.ScreenUpdating = False '画面更新を非表示にする
Application.DisplayAlerts = False '警告文を非表示にする
If ofdFD.Show() = -1 Then  'OKや参照・開くなどを押すと返り値【-1】が返ってくる
Set getf = objFS.GetFolder(ofdFD.SelectedItems(1))
DoEvents
For Each fl In getf.SubFolders ' フォルダ一覧を取得
cnt = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ChDir fl.Path
FName = Dir("*.xls")
Do While FName <> ""
Workbooks.Open FName '対象ファイルを開く
ThisWorkbook.Sheets(1).Cells(cnt, 2) = FName 'ファイル名
ThisWorkbook.Sheets(1).Cells(cnt, 1) = Sheets(1).Cells(1, 1).Value '取得したいセルの位置
ThisWorkbook.Sheets(1).Cells(cnt, 3) = fl '対象ファイルがあるフォルダー
cnt = cnt + 1
ActiveWorkbook.Close '対象ファイルを閉じる
FName = Dir()
Loop '繰り返す
Next fl
Else
MsgBox "キャンセルが押されました"
End If
Set ofdFD = Nothing
Application.DisplayAlerts = True  '警告文を表示する
Application.ScreenUpdating = True '画面更新表示する
End Sub

Sub Sample()

Dim ofdFD As Office.FileDialog

Dim objFS As New FileSystemObject

Dim strPath As String

Dim FName As String

Dim cnt As Long

strPath = ThisWorkbook.Path 'このVBAコードのあるファイルのパスを指定

Set ofdFD = Application.FileDialog(msoFileDialogFolderPicker)

With ofdFD 'ダイヤログボックスの設定

'ダイヤログボックスのファイル表示の設定

.InitialView = msoFileDialogViewDetails

'複数選択をしないよう設定

.AllowMultiSelect = False

End With

Application.ScreenUpdating = False '画面更新を非表示にする

Application.DisplayAlerts = False '警告文を非表示にする

If ofdFD.Show() = -1 Then 'OKや参照・開くなどを押すと返り値【-1】が返ってくる

Set getf = objFS.GetFolder(ofdFD.SelectedItems(1))

DoEvents

For Each fl In getf.SubFolders ' フォルダ一覧を取得

cnt = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ChDir fl.Path

FName = Dir("*.xls")

Do While FName <> ""

Workbooks.Open FName '対象ファイルを開く

ThisWorkbook.Sheets(1).Cells(cnt, 2) = FName 'ファイル名

ThisWorkbook.Sheets(1).Cells(cnt, 1) = Sheets(1).Cells(1, 1).Value '取得したいセルの位置

ThisWorkbook.Sheets(1).Cells(cnt, 3) = fl '対象ファイルがあるフォルダー

cnt = cnt + 1

ActiveWorkbook.Close '対象ファイルを閉じる

FName = Dir()

Loop '繰り返す

Next fl

Else

MsgBox "キャンセルが押されました"

End If

Set ofdFD = Nothing

Application.DisplayAlerts = True '警告文を表示する

Application.ScreenUpdating = True '画面更新表示する

End Sub

ダウンロード

当サイトの免責事項をお読みになってからお使いください。

フォイル値取得ツール 119.03 KB

Download

ファイルやコードの利用、WEBサイトの利用について

サンプルコードなどは当サイトの免責事項をよくお読みになってからお使いください。

カテゴリーで絞る

月で探す

一貫性のあるBookの値を取得するツールを作ってみた

taka

最新記事 by taka (全て見る)