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

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

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

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

Q&A

解決済

2回答

4420閲覧

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

ot2os

総合スコア23

VBA

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

0グッド

0クリップ

投稿2017/12/21 03:09

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

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

lang

1Option Explicit 2 3'暗号化をするテスト 4Sub test2() 5 Dim EncodeByte() As Byte, EncodeB64 As String 6 7 EncodeByte = encode_Public("あああ1234", "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent></RSAKeyValue>") 8 EncodeB64 = encodeBase64(EncodeByte) 9 10 Debug.Print (EncodeB64) 11End Sub 12 13'複合化をするテスト 14Sub test3() 15 Dim DecodeByte() As Byte, DecodeStr As String 16 17 DecodeByte = decodeBase64("okHIniM+3/6oG4KoJsihSE6PdwzKFGoOuiYCVzJJPEcC0R+vMKGsUBdZNkyy7CiR8fW44tJ4T1HtL3sw2TryxZF3NnFDbKUud8ZxYHRhL41C1htjjdGyPDRScI44wWxYmC1q1rFQmgx/zAJcsAbJfAV2yR2TZxO9FZD+bKYcVBA=") 18 DecodeStr = decode_Secret(DecodeByte, "<RSAKeyValue><Modulus>qQlZJlgWHZMLYx8yPl2WaWVcTX5IMy8YT3h7NV5TqPO3gaYx4TwOYIP427Nai3K1tEvJGPqCO/k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZp/p0DjbrvU6L/US9Av1PeGZj5ymBhn6hQXsq4eHsMRL3e5KVK8vE=</Modulus><Exponent>AQAB</Exponent><P>40lEJMhUVCittkfXqWB4N") 19 20 Debug.Print (DecodeStr) 21End Sub 22 23'公開鍵暗号化 24Private Function encode_Public(ByVal Hirabun As String, ByVal PublicKey As String) As Byte() 25 Dim arrUnicode() As Byte, arrEncrypted() As Byte, objRsa As Object 26 27 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") '★検証環境2(Win10x64FCU)ではここでエラー 28 29 '文字列をバイトに変換 30 arrUnicode = StrConv(Hirabun, vbUnicode) 31 32 '暗号化 33 objRsa.FromXmlString (PublicKey) 34 arrEncrypted = objRsa.Encrypt(arrUnicode, False) 35 36 Set objRsa = Nothing 37 38 encode_Public = arrEncrypted 39End Function 40 41'秘密鍵復号化 42Private Function decode_Secret(ByRef Angoubun() As Byte, ByVal SecretKey As String) As String 43 Dim arrDecrypted() As Byte, objRsa As Object 44 45 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") '★検証環境2(Win10x64FCU)ではここでエラー 46 '複合 47 objRsa.FromXmlString (SecretKey) '★検証環境1(Win7x86環境)ではここでエラー 48 arrDecrypted = objRsa.Decrypt(Angoubun, False) 49 50 Set objRsa = Nothing 51 52 'バイトを文字列に戻す 53 decode_Secret = StrConv(arrDecrypted, vbFromUnicode) 54End Function 55 56'BASE64エンコード 57Private Function encodeBase64(ByRef byteData() As Byte) As String 58 Dim objXML As Object, objElement As Object 59 60 Set objXML = CreateObject("MSXML2.DOMDocument") 61 Set objElement = objXML.CreateElement("tmp") 62 With objElement 63 .DataType = "bin.base64" 64 .NodeTypedValue = byteData 65 encodeBase64 = .Text 66 End With 67 Set objElement = Nothing 68 Set objXML = Nothing 69 70 ' 改行コードは削除 71 encodeBase64 = Replace(encodeBase64, vbLf, "") 72 encodeBase64 = Replace(encodeBase64, vbCr, "") 73End Function 74 75'BASE64デコード 76Private Function decodeBase64(ByVal encodedString As String) As Byte() 77 Dim objXML As Object, objElement As Object 78 79 Set objXML = CreateObject("MSXML2.DOMDocument") 80 Set objElement = objXML.CreateElement("tmp") 81 With objElement 82 .DataType = "bin.base64" 83 .Text = Trim(encodedString) 84 decodeBase64 = .NodeTypedValue 85 End With 86 Set objElement = Nothing 87 Set objXML = Nothing 88End Function

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

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

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

lang

1Sub Test1() 2 Dim SecretKey As String, PublicKey As String, objRsa As Object 3 Dim arrUnicode() As Byte, arrEncrypted() As Byte, arrDecrypted() As Byte 4 5 '文字列をバイトに変換 6 arrUnicode = StrConv("暗号化1234", vbUnicode) 7 8 Set objRsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") 9 10 '秘密鍵の生成 11 SecretKey = objRsa.ToXmlString(True) 12 13 '公開鍵の生成 14 PublicKey = objRsa.ToXmlString(False) 15 16 '暗号化 17 objRsa.FromXmlString (PublicKey) 18 arrEncrypted = objRsa.Encrypt(arrUnicode, False) 19 20 'Base64化 21 Dim Base64Encrypted As String 22 Base64Encrypted = encodeBase64(arrEncrypted) 23 Debug.Print "暗号化BASE64化:" & Base64Encrypted 24 25 '複合 26 objRsa.FromXmlString (SecretKey) 27 arrDecrypted = objRsa.Decrypt(decodeBase64(Base64Encrypted), False) 'arrEncryptedと同じものをdecodeBase64(Base64Encrypted)で代入 28 29 Debug.Print StrConv(arrDecrypted, vbFromUnicode) 30 31 Set objRsa = Nothing 32 33End 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

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

検証環境1

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

検証環境2

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

RSACryptoServiceProvider クラス

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

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

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

投稿2017/12/21 05:58

編集2017/12/21 06:15
sazi

総合スコア25138

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ot2os

2017/12/22 01: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)の値を元に戻してもエラーになる挙動が理解できないです。
guest

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の有効化と上記手順での秘密鍵取り出しで正常に動作しました。

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

投稿2017/12/22 03:03

ot2os

総合スコア23

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問