会社の新PCですが、セキュリティの高さからファイル移行が難航しています。
考え方としては、USBメモリーでファイルを移して行くのが、普通でしょう。
ところが、今回のＰＣは、社内で許可されたUSBメモリーでしか使えないの。
使用許可を申請しても、貸与の許可が下りた社員が少なくて、小生もダメだ。
と思っていたら、貸与する手続きに手違いがありまして許可されたと判明です。
ただ、このUSBは、パスワード付きで、これが通知されない限りは使えません。
案内されるまでは時間がかかりそうで、代わりにグーグルドライブを代用です。
会社は、企業向けGメールシステムを導入しており、このドライブも使用OKね。
だから、古いPC経由でグーグルドライブへ移したいファイルをアップロード。
これが終わると、新しいPCでダウンロードしでファイルを格納する作業です。
ところが、問題があって、エクセルのマクロ付きファイルはマクロが死にます。
つまり、拡張子が通常の”xlsx”に化けるので、このファイル形式はアップ禁止。
困ったなあと思いましたが、バイナリー形式で保存したファイルは生き残るな。
”xlsb”形式のファイルですが、データの構造、マクロのコード全体が大丈夫だ。
これも、保存されたデータがバイナリーになって、グーグルも読めないらしい。
ただ、ファイルを一つずつ変換し直してアップロードするのは、大変な作業だ。
なので、これをマクロでコードを書いてみましたが、これが意外に難しいのだ。
というのも、ブックを開けばマクロがすぐ起動するファイルもあったりするな。
マクロを動かさずに開くのに、マニュアル操作もありますが、これをマクロ化。
これから、バイナリー形式のファイルに保存した後、”xlsm”のファイルを削除。
動作は簡単で、変換するファイルのフォルダーを選んだら、ブックにリスト化。
このリストを使ってバイナリー変換の後、最後に通常のマクロファイルを削除。
というわけで、プロシージャ三つを”Call”して連続動作するようにして下さい。
最後にサンプルコードを紹介するので、使えそうだと思った人がいたら、ぜひ使ってほしいと思う自分なのでした。
＜サンプルコード＞
Sub GetFileList() 'ブックのシートにマクロの”.xlsm”ブックをリスト化
Dim TrgtFldr As String, fso As Object, folder As Object, file As Object
Dim i As Integer, Splt As Variant
Dim secAutomation As MsoAutomationSecurity
Cells.ClearContents
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "一覧にしたいフォルダが存在するフォルダを選択して下さい"
If .Show <> -1 Then Exit Sub
TrgtFldr = .SelectedItems(1)
End With
Range("A" & 2).Value = TrgtFldr & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(TrgtFldr) ' フォルダパスを取得
i = 1
For Each file In folder.files ' ファイル一覧の取得
Splt = Split(file.Name, ".")
If Splt(1) = "xlsm" Then
Range("B" & i).Value = file.Name
i = i + 1
End If
Next file
Set file = Nothing ' オブジェクトの解放
Set folder = Nothing
Set fso = Nothing
Columns.AutoFit '表示行列を整える
Rows.AutoFit
End Sub
Sub OpenAndSaveBinary() 'リスト化したマクロブックをバイナリーで保存
Dim fullpath_WB As Variant, wkbook As Workbook, Hdr As String
Dim Splt As Variant, i As Integer
Dim secAutomation As MsoAutomationSecurity
secAutomation = Application.AutomationSecurity
On Error Resume Next
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
fullpath_WB = ""
fullpath_WB = fullpath_WB & Range("A2").Value
fullpath_WB = fullpath_WB & Range("B" & i).Value
fullpath_WB = fullpath_WB & ""
Debug.Print fullpath_WB
Hdr = Replace(fullpath_WB, ".xlsm", "")
Application.AutomationSecurity = _
msoAutomationSecurityForceDisable
Set wkbook = Workbooks.Open(fullpath_WB, ReadOnly:=True)
ActiveWorkbook.SaveAs Filename:=Hdr & _
".xlsb", FileFormat:=xlExcel12, CreateBackup:=False
'FileFormat:=xlExcel12はバイナリーブック
ActiveWorkbook.Close
Next i
Application.AutomationSecurity = secAutomation
Application.ScreenUpdating = True
End Sub
Sub XlsmFileKill() 'リスト化したマクロブック("xlsm")を削除する
Dim fullpath_WB As Variant, i As Integer
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
fullpath_WB = ""
fullpath_WB = fullpath_WB & Range("A2").Value
fullpath_WB = fullpath_WB & Range("B" & i).Value
fullpath_WB = fullpath_WB & ""
Kill fullpath_WB
Next i
End Sub
0 件のコメント:
コメントを投稿