EXCELでpdf閲覧の検索画面を作る②

やっと念願のホグワーツ城に行ってきました。
一足先にクリスマス気分を堪能してきました。
画像


ちょっと時間が空いてしまいましたが、pdf閲覧の検索画面を作るの②回目です。

今回はファイル名がそのままだと内容がばればれなので、
ファイル名を乱数で作成して置き換える部分を考えます。
直接フォルダを見られることはないように、
検索できるノートpcには閲覧画面のEXCELへのショートカットのみ置いてはいますが、
フォルダにたどり着けないとは限らないので、ファイル名を意味の解らない乱数で生成することを思いつきました。
今回はpdfファイルが数千個あるので、意味のない数字のファイル名がダーッと並んでいるだけになります。

①元のファイル名のpdfファイルを別のフォルダにバックアップしておくこと
②元のファイル名を乱数で作成したファイル名に変更する。
③元のファイル名と乱数のファイル名が1対1になっていることを確認すること

以前に書いたPDFに対してJavaScriptを埋め込む前にこの作業を行います。

フォルダ限定のところでファイル名を指定していますので、
あらかじめ、乱数で作成したファイル名が必要になります。

乱数は整数で取得して、末尾に拡張子.pdfを追加します。
元のファイル名と乱数で作成したファイル名はリストにしておきます。

実際の検索画面は元のファイル名の先頭10桁を使って検索して、
ファイルを開く時にはリストで一致する乱数で作成したファイルをshellで開きます。

まず、元のファイル名の一覧を作成します。
♪自己責任で使ってください♪

Sub ①ファイル名取得()
'任意のフォルダに存在するすべてのファイル名を取得するには、Dir関数にワイルドカードを指定します。
'次のコードは、指定したpathのフォルダに存在するすべての「*.pdf」をアクティブシートに書き出します。
Dim buf As String
Dim Cnt As Long
Application.ScreenUpdating = False
Const Path As String = "C:\BBBB\CCCC\DDDD\"
'ここでフォルダ名を指定します。最後に\を付けるのを忘れないで。
buf = Dir(Path & "*.pdf") 'ここで拡張子を指定します。
Do While buf <> ""
Cnt = Cnt + 1
Cells(Cnt, 1) = buf
buf = Dir()
Loop
Application.ScreenUpdating = True
End Sub

次に、取り出したファイルの数だけ乱数で作成したファイル名を作って拡張子.pdfを追加します。
元のファイル名をA列に置いておいておきます

Sub ②乱数を発生させる_1から1000000000までの整数()
Dim Cnt As Long
Dim CntMax As Long
'アクティブなシートを対象にしています。
'必要に応じて、シート名は指定してください。
CntMax = Cells(Rows.Count, 1).End(xlUp).Row
Dim myRange As Range
Application.ScreenUpdating = False
Set myRange = Range(Cells(1, 2), Cells(CntMax, 2))
Randomize '乱数のシード値を初期化
myRange.Select
'乱数を発生させてSetした範囲に乱数を入れていく
For Each myRange In Selection
myRange.Value = Int((Rnd * 1000000000) + 1) '1000000000倍した値に1を加算してIntを取る
Next
Set myRange = Nothing
'乱数の最後に.pdfを追加して、pdf用の乱数ファイル名を生成
Dim Ransu As Long
Dim RansuS As String
Cnt = 1
CntMax = Cells(Rows.Count, 1).End(xlUp).Row
For Cnt = 1 To CntMax Step 1
Ransu = Cells(Cnt, 2).Value
RansuS = CStr(Ransu) & ".pdf"
Cells(Cnt, 3).Value = RansuS
Next Cnt
'ヘッダ行追加
Rows("1:1").Insert Shift:=xlDown
Range("A1").Value = "ファイル名"
Range("b1").Value = "乱数"
Range("c1").Value = "乱数ファイル名"
Application.ScreenUpdating = True
End Sub

最後にファイル名の変更です。
マクロが動く前提として、このマクロファイルを変更するファイルのあるフォルダに置いてから実行してください。
Sheet名を新旧ファイル名をここに置くとしてください。
新ファイル名をA列に旧ファイル名をB列に置いてください。
新旧のファイル名は2行目以降にコピペしてください。
新は乱数で作成したファイル名
旧は元のファイル名です。
このシートは後で検索の画面で使いますので、保存しておいてください。

Sub ファイル名の変更()
'このマクロファイルをファイル名を変更するファイルがあるフォルダに置いてからこのマクロを実行する
Dim OldName As String
Dim NewName As
Dim MyPass As String
Dim Cnt As Long
Dim CntMax As Long

MyPass = ThisWorkbook.Path
ThisWorkbook.Sheets("新旧ファイル名をここに置く").Select

Cnt = 2
CntMax = Cells(Rows.Count, 1).End(xlUp).Row
For Cnt = Cnt To CntMax Step 1
NewName = Cells(Cnt, 1).Value
OldName = Cells(Cnt, 2).Value
Name MyPass & "\" & OldName As MyPass & "\" & NewName
Next Cnt

End Sub
続きもなるべく近いうちに書かないと忘れそう …
乱数については VBA 乱数で色々ヒットしました。
今はVBAの情報が沢山あって助かります。
忘れるのが速くなっている自分用の備忘録ですが、誰かの役に立てるかもと思いつつ書いています。 

ブログ気持玉

クリックして気持ちを伝えよう!

ログインしてクリックすれば、自分のブログへのリンクが付きます。

→ログインへ

なるほど(納得、参考になった、ヘー)
驚いた
面白い
ナイス
ガッツ(がんばれ!)
かわいい

気持玉数 : 0

この記事へのコメント

この記事へのトラックバック