質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

91.25%

  • VBA

    1191questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1020questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

ExcelVBAでRSACryptoServiceProviderクラスを使うと実行時エラーが発生する

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 79

ot2os

score 9

ExcelVBAでRSA暗号化方式を利用して文字列を暗号化、複合化するテストをしていますが、「実行時エラー」で進行できなくなります。
しかも、環境によってエラーの出る場所とコードが異なります。

まずはコード全文を記載します。
直接実施するのはSub test2()Sub test3()です。

Option Explicit

'暗号化をするテスト
Sub test2()
    Dim EncodeByte() As Byte, EncodeB64 As String

    EncodeByte = encode_Public("あああ1234", "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent></RSAKeyValue>")
    EncodeB64 = encodeBase64(EncodeByte)

    Debug.Print (EncodeB64)
End Sub

'複合化をするテスト
Sub test3()
    Dim DecodeByte() As Byte, DecodeStr As String

    DecodeByte = decodeBase64("okHIniM+3/6oG4KoJsihSE6PdwzKFGoOuiYCVzJJPEcC0R+vMKGsUBdZNkyy7CiR8fW44tJ4T1HtL3sw2TryxZF3NnFDbKUud8ZxYHRhL41C1htjjdGyPDRScI44wWxYmC1q1rFQmgx/zAJcsAbJfAV2yR2TZxO9FZD+bKYcVBA=")
    DecodeStr = decode_Secret(DecodeByte, "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent><P>40lEJMhUVCittkfXqWB4N")

    Debug.Print (DecodeStr)
End Sub

'公開鍵暗号化
Private Function encode_Public(ByVal Hirabun As String, ByVal PublicKey As String) As Byte()
    Dim arrUnicode() As Byte, arrEncrypted() As Byte, objRsa As Object

    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")    '★検証環境2(Win10x64FCU)ではここでエラー

    '文字列をバイトに変換
    arrUnicode = StrConv(Hirabun, vbUnicode)

    '暗号化
    objRsa.FromXmlString (PublicKey)
    arrEncrypted = objRsa.Encrypt(arrUnicode, False)

    Set objRsa = Nothing

    encode_Public = arrEncrypted
End Function

'秘密鍵復号化
Private Function decode_Secret(ByRef Angoubun() As Byte, ByVal SecretKey As String) As String
    Dim arrDecrypted() As Byte, objRsa As Object

    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")    '★検証環境2(Win10x64FCU)ではここでエラー
    '複合
    objRsa.FromXmlString (SecretKey)    '★検証環境1(Win7x86環境)ではここでエラー
    arrDecrypted = objRsa.Decrypt(Angoubun, False)

    Set objRsa = Nothing

    'バイトを文字列に戻す
    decode_Secret = StrConv(arrDecrypted, vbFromUnicode)
End Function

'BASE64エンコード
Private Function encodeBase64(ByRef byteData() As Byte) As String
    Dim objXML As Object, objElement As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objElement = objXML.CreateElement("tmp")
    With objElement
        .DataType = "bin.base64"
        .NodeTypedValue = byteData
        encodeBase64 = .Text
    End With
    Set objElement = Nothing
    Set objXML = Nothing

    ' 改行コードは削除
    encodeBase64 = Replace(encodeBase64, vbLf, "")
    encodeBase64 = Replace(encodeBase64, vbCr, "")
End Function

'BASE64デコード
Private Function decodeBase64(ByVal encodedString As String) As Byte()
    Dim objXML As Object, objElement As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")
    Set objElement = objXML.CreateElement("tmp")
    With objElement
        .DataType = "bin.base64"
        .Text = Trim(encodedString)
        decodeBase64 = .NodeTypedValue
    End With
    Set objElement = Nothing
    Set objXML = Nothing
End Function

●エラー1
「検証環境1」でobjRsa.FromXmlString (SecretKey)を実行時に下記エラーが出ます。

実行時エラー '-2146233320(80131418)'
1行に無効な構文があります。

ちなみに、下記のようにエンコードとデコードを一気に実施するコードならうまく動きます。

Sub Test1()
    Dim SecretKey As String, PublicKey As String, objRsa As Object
    Dim arrUnicode() As Byte, arrEncrypted() As Byte, arrDecrypted() As Byte

    '文字列をバイトに変換
    arrUnicode = StrConv("暗号化1234", vbUnicode)

    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")

    '秘密鍵の生成
    SecretKey = objRsa.ToXmlString(True)

    '公開鍵の生成
    PublicKey = objRsa.ToXmlString(False)

    '暗号化
    objRsa.FromXmlString (PublicKey)
    arrEncrypted = objRsa.Encrypt(arrUnicode, False)

    'Base64化
    Dim Base64Encrypted As String
    Base64Encrypted = encodeBase64(arrEncrypted)
    Debug.Print "暗号化BASE64化:" & Base64Encrypted

    '複合
    objRsa.FromXmlString (SecretKey)
    arrDecrypted = objRsa.Decrypt(decodeBase64(Base64Encrypted), False) 'arrEncryptedと同じものをdecodeBase64(Base64Encrypted)で代入

    Debug.Print StrConv(arrDecrypted, vbFromUnicode)

    Set objRsa = Nothing

End Sub


●エラー2
「検証環境2」でSet objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")を実行時に下記エラーが出ます。

実行時エラー '-2146232576(80131700)'
オートメーションエラーです。

ちなみに、Set objRsa = CreateObject("InternetExplorer.Application")等は問題なく実施可能なため、CreateObjectコマンド自体は問題ないようです。

●参考にしたサイト
ExcelVBAでRSA暗号

●検証環境1
OS:Windows7x86
Office:Professional Plus 2010

●検証環境2
OS:Windows10x64 - バージョン:1709
Office:Professional Plus 2016

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

+2

検証環境1

RSA.FromXmlString メソッド (String)
で発生する例外は、
・パラメーターが null です。
・パラメーターの形式が正しくありません。
の2つしかありません。
なので、鍵の内容を確認されてみてはどうですか。

検証環境2

.NET Frameworkは有効になっていますか?

RSACryptoServiceProvider クラス

バージョン情報
.NET Framework
1.1 以降で使用可能

となっていますから、.NET Frameworkを使用していることは確実です。

コントロールパネル⇒プログラム⇒windowsの機能の有効化または無効化
から有効になっているかどうかを確認して見て下さい。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/12/22 10:54

    ご回答ありがとうございます。
    一つは解決しました。

    検証環境2のWindows10ですが、「.NET Framework 3.5」を有効にしたところ、検証環境1と同じ現象になりました。
    元から4.7は有効だったのですが、RSACryptoServiceProvider クラスの「1.1以降」の条件に含まれないんですね。


    そして検証環境1のエラーですが、SecretKey自体は`Sub Test1()`を途中で中断し、抜き出したものをそのままコピーしています。
    以下に試してみたことを追記します。

    (1).試しに`Sub test3()`からdecode_Secretファンクションに渡すSecretKeyの値を変えてみても同じ「オートメーションエラーです。」の表示でした。

    (2).`Sub Test1()`中の`objRsa.FromXmlString (SecretKey)`にブレークポイントを仕込んで、SecretKeyの値を変えてみてもやはり「オートメーションエラーです。」の表示でした。
     しかし、その後SecretKeyの値を元に戻して再開しても「オートメーションエラーです。」の表示でした。

    (3).`Sub Test1()`中で`objRsa.FromXmlString (SecretKey)`コマンドの直前に下記3行を挿入してみたところ、エラーの内容が変わりました。

    Set objRsa = Nothing
    Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
    SecretKey = objRsa.ToXmlString(True)

    出たエラーは下記の通り。

    実行時エラー '-2146893819(80090005)'
    データが正しくありません。

    公式Developer NetworkのRSA.ToXmlString メソッド、RSA.FromXmlString メソッド の仕様を見ても、特に使い方に問題があるようには見えず、行き詰っています。

    上記の試した内容から、ご指摘の通りSecretKeyの値が問題のようにも思えますが、(2)の値を元に戻してもエラーになる挙動が理解できないです。

    キャンセル

check解決した方法

0

原因判明しました。

なんてことはない、文字列のコピーの際、255文字制限で尻切れ状態の秘密鍵をコピーしてしまってエラーになっているだけでした。

お騒がせしてすみませんでした。
下記のサブプロシージャを作って、長いString変数でも表示できるようにしました。

Sub Print_Val(ByVal inpt As String)
    Dim Length As Long, First_Letter As Long, Last_Letter As Long, L200 As Long

    First_Letter = 1
    Last_Letter = 1
    L200 = 200

    Length = Len(inpt)

    Do Until Length <= Last_Letter
        Debug.Print (Mid(inpt, First_Letter, L200))
        Last_Letter = First_Letter + L200
        First_Letter = First_Letter + L200

        If First_Letter + L200 > Length Then
            L200 = Length - First_Letter + 1
        End If
    Loop

End Sub

.Net3.5の有効化と上記手順での秘密鍵取り出しで正常に動作しました。

本当に初歩的なことですみません。。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

ただいまの回答率

91.25%

関連した質問

  • 受付中

    VBA cpu使用率取得

    プログラミング初心者のものです。管理者の制約で、学校でタスクマネージャを開くことができません。そこでエクセルvbaでタスクマネージャを再現しようと思い、日々精進しております。学校に

  • 解決済

    excelvbaでのオブジェクトのキャストについて

    active出ないシートからコンボボックスオブジェクトを取得し、値をセットしようとしています。オブジェクト自体は以下のようにして取得はできました。 Worksheets("Sal

  • 受付中

    ExcelVBAでVLOOKUPの表記方法

    前提・実現したいこと 福祉施設のタイムカードを作ってます。 VLOOKUPで氏名、受給者番号、事業者番号、所属先をフォームの受給者番号から 利用者シートの(所属先名)(氏名)

  • 解決済

    エクセルのVBAの動作の高速化について

    エクセルのVBAの高速化を行いたいと思い質問させていただきます。 現在、きまった形のデータを作成するために、コピーandペースト作業時のミスをなくすためエクセルとVBAを使い

  • 解決済

    VBAの配列の質問

    VBAの配列で教えてほしい事があります。 同一ブック内に2つのsheetがあります。 ”集計結果”と”一時保管”です。 ”一時保管”はA~D列にデータが入っています。

  • 受付中

    【VBA】サブディレクトリも含めたファイル一覧を素早く取得したい

    以下のSample1とSample2はどちらもC:\Tempのサブディレクトも含めたファイル一覧を取得する関数です。 Sample1は'Sample2'よりも実行時間が短いですが、

  • 受付中

    VBAのexec()について

    外部batファイルをexec()で実行しました。 ですがその際、StdOutには4096バイトしか出力出来ないそうで、結果が途中までしか出力出来ません。 batファイルを複数に分け

  • 解決済

    VBA高速化について

    20個のエクセルファイルを読み込み、特定のシートにあるテーブルから特定の値を探し出し、その右横にあるセルの値を取り出します。 集計用のエクセルのテーブルでも、同じ特定の値をテーブル

同じタグがついた質問を見る

  • VBA

    1191questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1020questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。