2022-04-07

PowerShell Officeアプリケーションのインストール先を取得する

Microsoft Office のインストール先は、Windowsの32bit/64bit、Officeのバージョン、Windowsインストーラーテクノロジ (MSI)かクイック実行 (C2R)かによって異なります。
標準で起動するアプリケーションは以下のPowerShellでインストール先のパスを取得できます。


(Excelのインストール先を取得する場合)

(Get-ItemProperty 'HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\excel.exe').'(Default)'


複数のバージョンのOfficeがインストールされていて、標準で起動しないアプリケーションのパスを取得する場合は以下のように直接パスを探索することでも取得できます。

(Excel2016を指定して取得する場合)

Get-ChildItem -Path "C:\Program Files*\Microsoft Office" -Recurse -Filter "EXCEL.EXE" | % { $_.FullName } | ? {($_ -like "*Office16*") -and ($_ -notlike "*Updates*")}

2021-11-07

ORACLE_HOMEを取得するPowerShellワンライナー

(Get-ChildItem -Path HKLM:\SOFTWARE\ORACLE | Where-Object {$_.PSChildName -like "KEY_*"}).GetValue("ORACLE_HOME")

エイリアスを使うと、

(gci HKLM:\SOFTWARE\ORACLE | ? {$_.PSChildName -like "KEY_*"}).GetValue("ORACLE_HOME")

Windows 64-bit に Oracle Client 32-bit をインストールしている場合
(gci HKLM:\SOFTWARE\WOW6432Node\ORACLE | ? {$_.PSChildName -like "KEY_*"}).GetValue("ORACLE_HOME")

レジストリ・パラメータについて

データベース管理者リファレンス for Microsoft Windows によると

レジストリ・パラメータの概要
HKEY_LOCAL_MACHINE\SOFTWARE\ORACLE\KEY_HOMENAMEについて
コンピュータの新規OracleホームにOracle製品をインストールするたびに、HKEY_LOCAL_MACHINE\SOFTWARE\ORACLE\KEY_HOMENAMEが作成されます。
このサブキーにはほとんどのOracle製品に対するパラメータ値が含まれます
(略)
 ORACLE_HOME
 Oracle製品がインストールされるOracleホーム・ディレクトリを指定します。

とあります。
このレジストリのサブキーの情報は %ORACLE_HOME%\BIN\oracle.key に記載されています。したがって、以下のようにPATH を探索してレジストリのサブキーを取得することもできます。

Get-Content (Join-Path ($Env:Path.Split(';') | ? {($_ -ne "") -and (Test-Path (Join-Path $_  oracle.key))}) oracle.key)

上述のワンライナーでは 簡便なORACLE_HOME というプロパティがあるキーを取得するという方法を採用しています。


`oracle.key` のあるフォルダの一つ上のフォルダが `ORACLE_HOME` ですので、以下のワンライナーでも`ORACLE_HOME` が取得できます。
Split-Path ($Env:Path.Split(';') | ? {($_ -ne "") -and (Test-Path (Join-Path $_  oracle.key))})

2021-10-17

PowerShellでJISコードのメールを送信する (MailKit編) (2)

前回のMimeKit導入編に続き、今回は実装編です。

以下のサイトを参考にPowerShellでJISコード(ISO-2022-JP)でメールを送信するコードを書いてみます。

電子メールを送信するには?(MailKit編)[.NET 4.5、C#/VB]:.NET TIPS - @IT

これまで広く使われてきたSmtpClientクラスは現在、使用が推奨されていない。そこでオープンソースライブラリのMailKitでメールを送信する方法を説明する。


  • 一般的なメールソフトと同様、宛先、CC、件名、本文、添付ファイルを引数にした関数にしています。
  • 宛先、CC、添付ファイルについては複数項目を受け付けるため配列を引数にしています。簡略化のため、宛先とCCの Display Name はなしにしています。
function Send-JisMail {
param (
[string[]]$ToArray,
[string[]]$CcArray,
[string]$Subject,
[string]$Body,
[string[]]$FileArray
)
# If you don't want to use arrays as arguments
# $ToArray = $To.Replace(" ","").Split(",")
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\Portable.BouncyCastle.1.8.10\lib\net40\BouncyCastle.Crypto.dll"
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MimeKit.2.15.1\lib\net45\MimeKit.dll"
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MailKit.2.15.0\lib\net45\MailKit.dll"
$fromAddress = "sender@foo.com"
$fromName = $null
# 送信サーバ設定
$smtpServer = "smtp@foo.com"
$port = "587"
$user = "user"
$password = "password"
$message = New-Object Mimekit.MimeMessage
$jis = [Text.Encoding]::GetEncoding("iso-2022-jp")
$from = New-Object MimeKit.MailboxAddress($jis, $fromName, $fromAddress)
$message.From.Add($from)
#$ToArray = $toAddress.Replace(" ","").Split(",")
foreach ($to in $ToArray) {
$message.To.Add($to)
}
$message.Subject = $Subject
$textPart = New-Object MimeKit.TextPart([MimeKit.Text.TextFormat]::Plain)
$textPart.SetText($jis, $Body)
#添付ファイル設定
if ($FileArray) {
$multiPart = New-Object MimeKit.Multipart("mixed")
$multiPart.Add($textPart)
foreach ($file in $FileArray) {
$attachment = New-Object MimeKit.MimePart
$content = New-Object MimeKit.MimeContent([System.IO.File]::OpenRead($file), [MimeKit.ContentEncoding]::Default)
$attachment.Content = $content
$contentDisposition = New-Object MimeKit.ContentDisposition([MimeKit.ContentDisposition]::Attachment)
$attachment.ContentDisposition = $contentDisposition
$attachment.ContentTransferEncoding = [MimeKit.ContentEncoding]::Base64
$attachment.FileName = [System.IO.Path]::GetFileName($file)
#https://github.com/jstedfast/MimeKit/blob/master/FAQ.md#UntitledAttachments
# The following sentense will also work.
# $attachment.ContentDisposition.Parameters[0].EncodingMethod = [MimeKit.ParameterEncodingMethod]::Rfc2047
foreach ($param in $attachment.ContentDisposition.Parameters) {
$param.EncodingMethod = [MimeKit.ParameterEncodingMethod]::Rfc2047
}
$multiPart.Add($attachment)
}
$message.Body = $multiPart
} else {
$message.Body = $textPart
}
$client = New-Object MailKit.Net.Smtp.SmtpClient
$client.Connect($smtpServer, $port, $false)
$client.Authenticate($user, $password)
$client.Send($message)
$client.Disconnect($true)
}

使い方

関数を呼び出す際はSplattingを使うと分かりやすいと思います。

$args = @{
ToArray = @("recipient1@bar.com","recipient2@bar.com")
Subject = "件名"
Body = @"
こんにちは。
これは本文です。
"@
FileArray = @("C:\Temp\新しいテキスト ドキュメント.txt")
}
Send-JisMail @args

Outlookで受信すると添付ファイル名が"ATT0####.dat"になってしまう問題について

MimeKitのFAQにあるとおり、Outlookは RFC 2231 に対応しておらず文字化けすることがあります。上述のコードではFAQに合わせて RFC 2047 を使うようにしています。
参考: 添付ファイルにおける日本語のファイル名に関して

2021-10-16

PowerShellでJISコードのメールを送信する (MailKit編) (1)

SmtpClient編 に続きMailKit編です。

パッケージの確認

https://www.nuget.org/ にアクセスしてMailKitを検索します。
名前・バージョン・Dependenciesを確認して、依存パッケージを辿ります。
MailKit -> MimeKit -> Portable.BouncyCastleの順で依存関係があることが分かります。

MailKit のインストール

PowerShellを管理者モードで起動し、各パッケージをインストールします。

PS > Install-Package -Name Portable.BouncyCastle -Source https://www.nuget.org/api/v2
The package(s) come(s) from a package source that is not marked as trusted.
Are you sure you want to install software from 'https://www.nuget.org/api/v2'?
[Y] はい(Y) [A] すべて続行(A) [N] いいえ(N) [L] すべて無視(L) [S] 中断(S) [?] ヘルプ (既定値は "N"): Y
Name Version Source Summary
---- ------- ------ -------
Portable.BouncyCastle 1.8.10 https://www.nuget.org/api/v2 BouncyCastle portable version with ...
PS > Install-Package -Name MimeKit -Source https://www.nuget.org/api/v2
The package(s) come(s) from a package source that is not marked as trusted.
Are you sure you want to install software from 'https://www.nuget.org/api/v2'?
[Y] はい(Y) [A] すべて続行(A) [N] いいえ(N) [L] すべて無視(L) [S] 中断(S) [?] ヘルプ (既定値は "N"): Y
Install-Package : Dependency loop detected for package 'MimeKit'.
発生場所 行:1 文字:1
+ Install-Package -Name MimeKit -Source https://www.nuget.org/api/v2
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ CategoryInfo : Deadlock detected: (MimeKit:String) [Install-Package]、Exception
+ FullyQualifiedErrorId : DependencyLoopDetected,Microsoft.PowerShell.PackageManagement.Cmdlets.InstallPackage
PS > Install-Package -Name MimeKit -Source https://www.nuget.org/api/v2 -SkipDependencies
The package(s) come(s) from a package source that is not marked as trusted.
Are you sure you want to install software from 'https://www.nuget.org/api/v2'?
[Y] はい(Y) [A] すべて続行(A) [N] いいえ(N) [L] すべて無視(L) [S] 中断(S) [?] ヘルプ (既定値は "N"): Y
Name Version Source Summary
---- ------- ------ -------
MimeKit 2.15.1 https://www.nuget.org/api/v2 An Open Source library for creating...
PS > Install-Package -Name MailKit -Source https://www.nuget.org/api/v2
The package(s) come(s) from a package source that is not marked as trusted.
Are you sure you want to install software from 'https://www.nuget.org/api/v2'?
[Y] はい(Y) [A] すべて続行(A) [N] いいえ(N) [L] すべて無視(L) [S] 中断(S) [?] ヘルプ (既定値は "N"): Y
Name Version Source Summary
---- ------- ------ -------
MailKit 2.15.0 https://www.nuget.org/api/v2 An Open Source .NET mail-client lib
...

Dependency loop detected について

Dependency loop detected というエラーが出たら、-SkipDependencies オプションを付けて実行します。
https://github.com/OneGet/oneget/issues/475 にあるとおり、現行の OneGetInstall-Package は単純な依存関係でないとエラーが出るようです。PackageManagementがOneGetではなくなるPowerShellGet v3で解消するようですが、現在はベータ版ということもあり確認しておりません。
なお、現在の私のInstall-Package コマンドレットのモジュールとバージョンは以下のとおりです。

PS > Get-Command -Name Install-Package | Select-Object -Property ModuleName
ModuleName
----------
PackageManagement
PS > Get-InstalledModule PackageManagement
Version Name Repository Description
------- ---- ---------- -----------
1.4.7 PackageManagement PSGallery PackageManagement (a.k.a. OneGet) is a new way t...

アセンブリの読み込み

ダウンロードしてアセンブリを読み込んでみます。ダウンロードしたパッケージは -Destination を指定していなければ "C:\Program Files\PackageManagement\NuGet\Packages\” にあります。
Add-Type コマンドレットでMailKit.dllを読み込んでみます。

PS > Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MailKit.2.15.0\lib\net45\MailKit.dll"
Add-Type : 要求された型のうち 1 つまたは複数を読み込めませんでした。詳細については、LoaderExceptions プロパティを取得してください。
発生場所 行:1 文字:1
+ Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\Mai ...
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ CategoryInfo : NotSpecified: (:) [Add-Type], ReflectionTypeLoadException
+ FullyQualifiedErrorId : System.Reflection.ReflectionTypeLoadException,Microsoft.PowerShell.Commands.AddTypeCommand

エラーが発生しました。

LoaderExceptions プロパティを取得してください。

とのことですので、try-catchブロックで囲んで実行します。

try
{
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MailKit.2.15.0\lib\net45\MailKit.dll"
}
catch [System.Reflection.ReflectionTypeLoadException]
{
Write-Host "Message: $($_.Exception.Message)"
Write-Host "StackTrace: $($_.Exception.StackTrace)"
Write-Host "LoaderExceptions: $($_.Exception.LoaderExceptions)"
}
Message: 要求された型のうち 1 つまたは複数を読み込めませんでした。詳細については、LoaderExceptions プロパティを取得してください。
StackTrace: 場所 System.Reflection.RuntimeModule.GetTypes(RuntimeModule module)
場所 System.Reflection.Assembly.GetTypes()
場所 Microsoft.PowerShell.Commands.AddTypeCommand.LoadAssemblyFromPathOrName(List`1 generatedTypes)
場所 Microsoft.PowerShell.Commands.AddTypeCommand.EndProcessing()
場所 System.Management.Automation.CommandProcessorBase.Complete()
LoaderExceptions: System.IO.FileNotFoundException: ファイルまたはアセンブリ 'MimeKit, Version=2.15.0.0, Culture=neutral, PublicKeyToken=bede1c8a46c66814'、またはその
依存関係の 1 つが読み込めませんでした。指定されたファイルが見つかりません。
ファイル名 'MimeKit, Version=2.15.0.0, Culture=neutral, PublicKeyToken=bede1c8a46c66814' です。'MimeKit, Version=2.15.0.0, Culture=neutral, PublicKeyToken=bede1c8a46c66814'

依存関係にあるMimeKitを先に読み込む必要があることが分かります。
したがって、

Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\Portable.BouncyCastle.1.8.10\lib\net40\BouncyCastle.Crypto.dll"
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MimeKit.2.15.1\lib\net45\MimeKit.dll"
Add-Type -Path "C:\Program Files\PackageManagement\NuGet\Packages\MailKit.2.15.0\lib\net45\MailKit.dll"

の順にするとエラーなく各アセンブリを読み込むことができます。
なお、以下のようにAdd-Type の代わりに .NET Framework のLoadFileメソッドを使うこともできます。その場合は依存関係によるエラーは出ません。

[System.Reflection.Assembly]::LoadFile("C:\Program Files\PackageManagement\NuGet\Packages\MailKit.2.15.0\lib\net45\MailKit.dll")

次回実装編に続く。

2021-10-08

PowerShellでJISコードのメールを送信する (SmtpClient編[obsoleted])

こちらにあるとおり

ℹ 重要
SmtpClientは多くの最新プロトコルをサポートしていないため、新規開発にSmtpClientクラスを使用することはお勧めしません。代わりにMailKitや他のライブラリを使用してください。詳細については、GitHubのSmtpClient shouldn’t be usedをご覧ください。

SmtpClientクラスは廃止(obsolete)となりました。

後継のMailkitを使用したバージョンはこちらです。


ここでは、SmtpClientクラスを使って

を参考にPowerShellでJISコード(ISO-2022-JP)でメールを送信するコードを書いてみます。

  • 元のコードからSMTP認証あり、添付ファイルありに変更しています。
  • 一般的なメールソフトと同様、宛先、CC、件名、本文、添付ファイルを引数にした関数にしています。
  • 宛先、CC、添付ファイルについては複数項目を受け付けるため配列を引数にしています。簡略化のため、宛先とCCの Display Name はなしにしています。
function EncodeBase64([string]$str, [Text.Encoding]$enc) {
if (!$str) {
return $null
}
$base64str = [Convert]::ToBase64String($enc.GetBytes($str))
Return [string]::Format("=?{0}?B?{1}?=", $enc.BodyName, $base64str)
}
function Send-JisMail {
param (
[string[]]$toArray,
[string[]]$ccArray,
[string]$subject,
[string]$body,
[string[]]$fileArray
)
# If you don't want to use arrays as arguments
# $toArray = $to.Replace(" ","").Split(",")
$fromAddress = "sender@foo.com"
## If you dont't need display nama, set empty
$fromName = ""
# 送信サーバ設定
$server = "smtp@foo.com"
$port = "587"
$user = "user"
$password = "password"
$client = New-Object Net.Mail.SmtpClient($server, $port)
$client.Credentials = New-Object Net.NetworkCredential($user, $password)
$message = New-Object Net.Mail.MailMessage
$jis = [Text.Encoding]::GetEncoding("iso-2022-jp")
# 送信元
$from = New-Object Net.Mail.MailAddress($fromAddress, $fromName)
$message.From = New-Object Net.Mail.MailAddress($from)
# 送信先
foreach ($to in $toArray) {
$message.To.Add($to)
}
# CC
foreach ($cc in $ccArray) {
$message.CC.Add($cc)
}
# 件名
#$message.Subject = EncodeBase64 $subject $jis
# for .NET Framework 4.5
$message.Subject = EncodeBase64 (EncodeBase64 $subject $jis) $jis
# 本文
$view = [Net.Mail.AlternateView]::CreateAlternateViewFromString($body, $jis, [Net.Mime.MediaTypeNames]::Text.Plain)
$view.TransferEncoding = [Net.Mime.TransferEncoding]::SevenBit
$message.AlternateViews.Add($view)
# 添付ファイル
foreach ($file in $fileArray) {
$attachment = New-Object Net.Mail.Attachment($file)
$message.Attachments.Add($attachment)
}
$client.Send($message)
$message.Dispose()
}

使い方

関数を呼び出す際はSplattingを使うと分かりやすいと思います。

$args = @{
toArray = @("recipient1@bar.com","recipient2@bar.com")
subject = "件名"
body = @"
こんにちは。
これは本文です。
"@
fileArray = @("C:\Temp\新しいテキスト ドキュメント.txt")
}
Send-JisMail @args

.NET Framework 4.5 の System.Net.Mail は、エンコードした件名をデコードしてしまう(base64を指定してもQuoted-printableになる)とのことです。
そのため、上記のコードでは二重にエンコードしています。

2020-07-22

PL/SQLから日本語(JIS)でメール送信する

ここでは、

にあるサンプルコード
DECLARE
c UTL_SMTP.CONNECTION;
PROCEDURE send_header(name IN VARCHAR2, header IN VARCHAR2) AS
BEGIN
UTL_SMTP.WRITE_DATA(c, name || ': ' || header || UTL_TCP.CRLF);
END;
BEGIN
c := UTL_SMTP.OPEN_CONNECTION('smtp-server.acme.com');
UTL_SMTP.HELO(c, 'foo.com');
UTL_SMTP.MAIL(c, 'sender@foo.com');
UTL_SMTP.RCPT(c, 'recipient@foo.com');
UTL_SMTP.OPEN_DATA(c);
send_header('From', '"Sender" <sender@foo.com>');
send_header('To', '"Recipient" <recipient@foo.com>');
send_header('Subject', 'Hello');
UTL_SMTP.WRITE_DATA(c, UTL_TCP.CRLF || 'Hello, world!');
UTL_SMTP.CLOSE_DATA(c);
UTL_SMTP.QUIT(c);
EXCEPTION
WHEN utl_smtp.transient_error OR utl_smtp.permanent_error THEN
BEGIN
UTL_SMTP.QUIT(c);
EXCEPTION
WHEN UTL_SMTP.TRANSIENT_ERROR OR UTL_SMTP.PERMANENT_ERROR THEN
NULL; -- When the SMTP server is down or unavailable, we don't have
-- a connection to the server. The QUIT call raises an
-- exception that we can ignore.
END;
raise_application_error(-20000,
'Failed to send mail due to the following error: ' || sqlerrm);
END;

を、日本語JISコード(ISO-2022-JP)で送れるように書き換えてみます。
ついでに、SMTP認証あり、ポート番号を587に変更し、プロシージャ化しています。

CREATE OR REPLACE PROCEDURE SEND_MAIL(
IN_FROM_NAME VARCHAR2,
IN_FROM_ADDRESS VARCHAR2,
IN_TO_ADDRESS VARCHAR2,
IN_SUBJECT VARCHAR2,
IN_MESSAGE VARCHAR2,
IN_AUTH_USER VARCHAR2,
IN_AUTH_PASSWORD VARCHAR2
) AS
c UTL_SMTP.CONNECTION;
host CONSTANT VARCHAR2(64) := 'foo.com';
port CONSTANT NUMBER := 587;
-- ヘッダー部送信
-- UTL_ENCODE.MIMEHEADER_ENCODE(buf, 'ISO2022-JP')を使うと=?iso-2022-jp?B?が=?ISO2022-JP?B?になるため環境により文字化けする。
-- Each line of characters MUST be no more than 998 characters, and SHOULD be no more than 78 characters, excluding the CRLF.(RFC 2822 2.1.1)
PROCEDURE SEND_HEADER (
IN_NAME IN VARCHAR2
,IN_HEADER IN VARCHAR2
,IN_ADDRESS IN VARCHAR2 := NULL
) AS
BEGIN
UTL_SMTP.WRITE_DATA(c, IN_NAME || ': ');
UTL_SMTP.WRITE_DATA(c, '=?iso-2022-jp?B?');
UTL_SMTP.WRITE_RAW_DATA(c, UTL_ENCODE.BASE64_ENCODE(UTL_RAW.CAST_TO_RAW(CONVERT(IN_HEADER, 'ISO2022-JP'))));
UTL_SMTP.WRITE_DATA(c, '?=');
IF IN_ADDRESS IS NOT NULL THEN
UTL_SMTP.WRITE_DATA(c, '<' || IN_ADDRESS || '>');
END IF;
UTL_SMTP.WRITE_DATA(c, UTL_TCP.CRLF);
END;
BEGIN
c := UTL_SMTP.OPEN_CONNECTION(host, port);
UTL_SMTP.EHLO(c, host);
-- SMTP認証(PLAIN)
-- 11.2.0.1以前
--UTL_SMTP.COMMAND(c, 'AUTH', 'PLAIN ' || UTL_ENCODE.TEXT_ENCODE(CHR(0)|| IN_AUTH_USER || CHR(0)|| IN_AUTH_PASSWORD, NULL, UTL_ENCODE.BASE64));
-- 11.2.0.2以上
UTL_SMTP.AUTH(c => c, username => IN_AUTH_USER, password => IN_AUTH_PASSWORD, schemes => UTL_SMTP.all_schemes);
UTL_SMTP.MAIL(c, IN_FROM_ADDRESS);
UTL_SMTP.RCPT(c, IN_TO_ADDRESS);
UTL_SMTP.OPEN_DATA(c);
--ヘッダ
SEND_HEADER('From', IN_FROM_NAME, IN_FROM_ADDRESS);
UTL_SMTP.WRITE_DATA(c, 'To: ' || IN_TO_ADDRESS || UTL_TCP.CRLF);
SEND_HEADER('Subject', IN_SUBJECT);
UTL_SMTP.WRITE_DATA(c, 'MIME-Version: 1.0' || UTL_TCP.CRLF);
UTL_SMTP.WRITE_DATA(c, 'Content-Type: text/plain; charset=iso-2022-jp' || UTL_TCP.CRLF);
UTL_SMTP.WRITE_DATA(c, 'Content-Transfer-Encoding: 7bit' || UTL_TCP.CRLF);
UTL_SMTP.WRITE_DATA(c, UTL_TCP.CRLF);
-- 本文
UTL_SMTP.WRITE_RAW_DATA(c, UTL_RAW.CAST_TO_RAW(CONVERT(IN_MESSAGE, 'ISO2022-JP')));
UTL_SMTP.CLOSE_DATA(c);
UTL_SMTP.QUIT(c);
EXCEPTION
WHEN UTL_SMTP.transient_error OR UTL_SMTP.permanent_error THEN
BEGIN
UTL_SMTP.QUIT(c);
EXCEPTION
WHEN UTL_SMTP.TRANSIENT_ERROR OR UTL_SMTP.PERMANENT_ERROR THEN
NULL; -- When the SMTP server is down or unavailable, we don't have
-- a connection to the server. The QUIT call will raise an
-- exception that we can ignore.
END;
raise_application_error(-20000,
'Failed to send mail due to the following error: ' || sqlerrm);
END;
/


  • ヘッダのエンコードにはUTL_ENCODE.MIMEHEADER_ENCODEを使いたいところですが、キャラクタ・セットが iso-2022-jp ではなく ISO2022-JP と出力されてしまい、環境によって文字化けするため、使わないようにしています。
  • RFC2822では1行の文字数について、CRLFを除く998未満(MUST)、78文字未満(SHOULD)と規定されており、UTL_ENCODE.MIMEHEADER_ENCODEを使えば1行当たり78文字未満に分割(folding)してくれるのですが、上記のコードでは考慮していませんのでご注意ください。

2020-06-24

VBA 丸めのまとめ

VBA(Visual Basic for Application)における数値の丸めについてまとめておきます。

偶数丸め(JIS丸め、銀行丸め)

VBA標準のRound関数は偶数丸め(JIS丸め、銀行丸め)なのでそのまま使えるのですが、整数部での丸め(小数部桁数に負の値を指定する)ができません。以下の関数を作り、拡張します。

' 偶数丸め(整数部丸め対応)
Public Function RoundHalfEven(ByVal number As Double, Optional ByVal digitsAfterDecimal As Long = 0) As Double
If digitsAfterDecimal < 0 Then
Dim shift As Double
shift = 10 ^ digitsAfterDecimal
RoundHalfEven = Round(number * shift) / shift
Else
RoundHalfEven = Round(number, digitsAfterDecimal)
End If
End Function

四捨五入

Excel VBAの場合、ワークシート関数のRoundを使えばよいのですが、Access や VBScript では使えないので自作しておきます。

' 四捨五入
Public Function RoundHalfUp(ByVal number As Double, Optional ByVal digitsAfterDecimal As Long = 0) As Double
Dim shift As Long
shift = 10 ^ digitsAfterDecimal
'浮動小数点誤差を避けるため十進型に変換する
RoundHalfUp = Fix(CDec(number) * shift + 0.5 * sgn(number)) / shift
End Function

Decimal型はVBAでは宣言できないため、CDec関数で変換する必要があります。Currency 型は小数部4桁に制限されるため使用しません。

なお、Decimal型との演算はDecimal型に変換されて行われます。

? 1.2-1.1
9.99999999999999E-02
? CDec(0)+1.2-1.1
0.1

有効数字に丸め

有効数字に丸める場合です。以下は偶数丸めの場合で上述のRoundHalfEven関数を使用しています。四捨五入で丸める場合は、上述のRoundHalfUp関数に置き換えてください。
桁数の初期値は3桁にしてあります。

'有効数字に丸め(初期値3桁)
Public Function RoundSignificantFigures(ByVal number As Double, Optional ByVal digits As Long = 3) As Double
If number = 0 Then
RoundSignificantFigures = 0
Else
' 偶数丸め
RoundSignificantFigures = RoundHalfEven(number, digits - 1 - Int(Log(number) / Log(10)))
End If
End Function

有効数字取得の考え方は、Oracleで有効数字を取得する。を参考にしてください。

床関数(Floor)

VBAのInt関数は床関数(Floor Function)と同じですので、そのまま使えます。床関数は実数x に対して x 以下の最大の整数と定義されます(Wikipedia
)が、Excelワークシート関数と同様に第2引数に基準値がとれるように拡張します。

' 床関数
Public Function Floor(ByVal number As Double, Optional ByVal significance As Double = 1) As Double
If significance = 0 Or (number > 0 And significance < 0) Then
Err.Raise 5 'プロシージャの呼び出し、または引数が不正です。
End If
Floor = Int(CDec(number) / significance) * significance
End Function

第1引数が正で第2引数が負の場合、正しい結果を返さないので、Excelのワークシート関数 Floorと態度を合わせてエラーにしています。

天井関数(Ceiling, Ceil)

天井関数(Ceiling, Ceil)は、数直線をイメージすると床関数を左右反転したものです。したがって、数値を正負反転して床関数で処理し、元に戻せばよいことになります。

' 天井関数
Public Function Ceiling(ByVal number As Double, Optional ByVal significance As Double = 1) As Double
If significance = 0 Or (number > 0 And significance < 0) Then
Err.Raise 5 'プロシージャの呼び出し、または引数が不正です。
End If
Ceiling = -Int(-CDec(number) / significance) * significance
End Function