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 365アイコン(imageMso)一覧(I)

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

  2. Office関連

    YouTube動画挿入アドイン for PowerPoint

    前回の記事でPowerPoint 2013でYouTubeの動画が挿入…

  3. アイコン一覧

    Office 2013 アイコン一覧(S)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    Data Explorerのフォーラム&ブログ

    前回の記事で紹介した「Data Explorer」ですが、すでにフォー…

  5. Office関連

    [閑話]Wordの「線種とページ罫線と網かけの設定」って英語版では何っていうの?

    Officeの機能について調べるとき、日本語での情報が無いときは英語圏…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP