*

ウィルスメールの注意喚起です。

本日、行政書士うすい法務事務所のメールアカウントに下記のウィルスメールが来ました。

アップルを名乗っていますが、当然のことながら、アップル社とは無関係です。

ウィルスメールの件名：appleが犯したポリシー

ウィルスメールの内容

Apple ID

あなたの App26135l68084e ID は、いくつかの違反したポリシーのために無効になります

日時:

ケースID:

2018 年 6 月 1 日 06:16 AM JST

ID-66574618

お客様のアカウント情報の一部のデータが無効で、確認されていないようです。

App26135l68084e IDアカウントを引き続き使用するためには、アカウント情報を確認する必要があります。
アカウントを元に戻すには、添付ファイル（P40D8534F）を開き、ファイルを保存してからウェブブラウザで開きます。無効になったアカウントは、電子メール、連絡先、写真、およびAppl68084eに保存されている他のデータとともに削除されるため、すぐにこれを行う必要があります。

24時間以内にお客様からの返信がない場合、お客様のアカウントは無効になります

誠実に、

Appl68084e サポート

Apple Inc. すべての権利を保有..

以上です。

件名からして日本語がおかしいですよね。
この件名では意味が不明です。

さすがにこのウィルスメールに信ぴょう性を感じる方は少ないかとは思いますが、メールを受信して不安に駆られる方もいないとも限りません。

当然ながら、このウィルスメールに記載されたリンクは絶対にクリックしないでください。

—

Option Compare Database
Dim strYYMM As String
Dim strMSG As String
Dim strSQL As String

Private Sub cmd空白CHK_Click()

‘空白入力対象データをTBLに移す
If fun姓名データ移行 = False Then Exit Sub

End Sub
Private Sub cmd空白修正_Click()
‘空白入力対象データをTBLに移す
If fun姓名データ移行 = False Then Exit Sub

End Sub

‘空白入力対象データをTBLに移す
Function fun姓名データ移行() As Boolean

Dim DB              As DAO.Database
Dim intCount        As Integer

On Error GoTo err_fun姓名データ移行

fun姓名データ移行 = False

Set DB = CurrentDb()
‘最初に入力用FLDに移し、半角を全角に、かなはカタカナにする

strSQL = “”
strSQL = strSQL & “UPDATE T_お宿メインデータ SET T_お宿メインデータ.氏名 = Replace([お名前],chr(32),chr(-32448)),”
strSQL = strSQL & “T_お宿メインデータ.氏名カナ = StrConv(Replace([よみがな],Chr(32),Chr(-32448)),16)”

DB.Execute strSQL

‘T_姓名データへ移す

strSQL = “delete * from T_姓名データ”
DB.Execute strSQL

strSQL = “”
strSQL = strSQL & “INSERT INTO T_姓名データ ( 企業ID, 企業名, 社員番号, お名前, よみがな, 氏名, 氏名カナ ) “
strSQL = strSQL & “SELECT 企業ID, 企業名, 社員番号, [お名前], [よみがな], 氏名, 氏名カナ “
strSQL = strSQL & “FROM T_お宿メインデータ “
strSQL = strSQL & “GROUP BY 企業ID, 企業名, 社員番号, [お名前], [よみがな], 氏名, 氏名カナ;”

DB.Execute strSQL

‘空白がないデータにチェック
Call sub空白無し件数(intCount)

‘ERRのないデータ削除
strSQL = “”
strSQL = strSQL & “delete * from T_姓名データ “
strSQL = strSQL & “where [ERR]=False”

DB.Execute strSQL

fun姓名データ移行 = True

If intCount > 0 Then
MsgBox intCount & “件の空白が無いデータがありました。”
Else
MsgBox “空白が無いデータはありませんでした。”
End If

exit_fun姓名データ移行:

DB.Close: Set DB = Nothing

Exit Function

err_fun姓名データ移行:

MsgBox Err.Description
Resume exit_fun姓名データ移行

End Function

‘
Sub fun空白修正()

Dim DB              As DAO.Database
Dim RS              As DAO.Recordset

On Error GoTo err_fun空白修正

Set DB = CurrentDb()

‘最初に入力値の半角空白を全角

strSQL = “”
strSQL = “UPDATE T_姓名データ “
strSQL = “SET T_姓名データ.氏名 = Replace([氏名],chr(32),chr(-32448)), T_姓名データ.氏名カナ = Replace([氏名カナ],chr(32）,chr(-32448)) “
strSQL = “where T_姓名データ.選択 = true “

DB.Execute strSQL

‘空白無データのERRをチェック

‘T_お宿メインデータを更新

‘履歴保存

‘件数MSG

exit_fun空白修正:

RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing

Exit Sub

err_fun空白修正:

MsgBox Err.Description
Resume fun空白修正

End Sub

‘空白が無いデータ
Sub sub空白無し件数(intCount As Integer)

Dim DB              As DAO.Database
Dim RS              As DAO.Recordset
Dim chk             As Boolean

Set DB = CurrentDb()

strSQL = “”
strSQL = strSQL & “Select * from T_姓名データ “

Set RS = DB.OpenRecordset(strSQL, dbOpenDynaset)

intCount = 0
Do Until RS.EOF
chk = False
‘空白が無いとき
If InStr(RS!氏名, Chr(-32448)) = 0 Or InStr(RS!氏名カナ, Chr(-32448)) = 0 Then
chk = True
intCount = intCount + 1
End If

RS.Edit
RS![Err] = chk
RS.Update

RS.MoveNext
Loop

RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing

End Sub