Office関連

ファイルをBase64エンコード・デコードするVBAマクロ

以前書いたファイルのBase64エンコード・デコード処理を行うVBAマクロをメモとして残しておきます。

Option Explicit

Public Sub Sample()
  Sheet1.TextBox1.Text = EncodeBase64("C:\Test\Sample.pdf")
  Debug.Print DecodeBase64(Sheet1.TextBox1.Text, "C:\Test\Sample_Decode.pdf")
End Sub

Private Function EncodeBase64(ByVal FilePath As String) As String
'ファイルをBase64エンコード
  Dim elm As Object
  Dim ret As String
  Const adTypeBinary = 1
  Const adReadAll = -1
  
  ret = "" '初期化
  On Error Resume Next
  Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
  With CreateObject("ADODB.Stream")
    .Type = adTypeBinary
    .Open
    .LoadFromFile FilePath
    elm.DataType = "bin.base64"
    elm.nodeTypedValue = .Read(adReadAll)
    ret = elm.Text
    .Close
  End With
  On Error GoTo 0
  EncodeBase64 = ret
End Function

Private Function DecodeBase64(ByVal Base64Str As String, ByVal FilePath As String) As Long
'ファイルをBase64デコード
  Dim elm As Object
  Dim ret As Long
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  ret = -1 '初期化
  On Error Resume Next
  Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
  elm.DataType = "bin.base64"
  elm.Text = Base64Str
  With CreateObject("ADODB.Stream")
    .Type = adTypeBinary
    .Open
    .Write elm.nodeTypedValue
    .SaveToFile FilePath, adSaveCreateOverWrite
    .Close
  End With
  If Err.Number <> 0 Then ret = 0
  On Error GoTo 0
  DecodeBase64 = ret
End Function

上記の通り、エラー処理は適当です。

空白文字を一括置換するWordマクロ前のページ

2014年5月の人気記事次のページ

関連記事

  1. Office関連

    Office 365 APIをVBAから呼び出す(1)

    2015年4月に公開されたOffice Teamのブログ記事「Toda…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(T)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Office関連

    Office 2016でACROBATタブが表示されない!?(Acrobat DC)

    2015/10/16 追記:先日公開されたアップデート「15.00…

  4. アイコン一覧

    Office 365アイコン(imageMso)一覧(D)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  5. アイコン一覧

    Office 2013 アイコン一覧(H)

    ・Office 2013 アイコン一覧 NUM…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP