Dim objIE As Object 'ＩＥオブジェクト参照用
Dim myWord As String

'IEのオブジェクトを作る

If Len(ActiveCell.Value) = 0 Then

Exit Sub

End If

myWord = funct_URL_Encode(CStr(ActiveCell.Value))

Set objIE = CreateObject("InternetExplorer.application")

objIE.Visible = True
objIE.Navigate "http://search.yahoo.co.jp/search?p=" & myWord & "&aq=-1&oq=&ei=UTF-8&fr=top_of3_sa&x=wrt"

Set objIE = Nothing

End Sub

Sub Search_YahooMap()

Dim objIE As Object 'ＩＥオブジェクト参照用
Dim myWord As String

'IEのオブジェクトを作る

If Len(ActiveCell.Value) = 0 Then

Exit Sub

End If

myWord = funct_URL_Encode(CStr(ActiveCell.Value))

Set objIE = CreateObject("InternetExplorer.application")

objIE.Visible = True
objIE.Navigate "http://maps.loco.yahoo.co.jp/maps?p=" & myWord & "&ei=utf-8"

Set objIE = Nothing

End Sub

Function funct_URL_Encode(BasicCharactor As String) As String

Dim objScript As Object
Dim objJAVASC As Object

Set objScript = CreateObject("ScriptControl")
objScript.Language = "Jscript"

Set objJAVASC = objScript.CodeObject
funct_URL_Encode = objJAVASC.encodeURIComponent(BasicCharactor)

Set objScript = Nothing
Set objJAVASC = Nothing

End Function

Set ZOODIR01 = WScript.CreateObject("InternetExplorer.application")
ZOODIR01.Navigate "mailto:***@***.ne.jp?Subject=エラー対応依頼"
Set ZOODIR01 = Nothing

Dim boolExist As Boolean

On Error GoTo MY_ERROR_STATE

Range("X56X").Select

MsgBox "OK"

Exit Sub

MY_ERROR_STATE:

boolExist = myfunct_CreateErrorLog(Application.DefaultFilePath)

Err.Raise Err.Number

End Sub

Function myfunct_CreateErrorLog(argERRORLOG_PATH As String, Optional argSQL_COMMAND As String) As Boolean

Dim myFSO_Objeect As Object

If IsNull(argERRORLOG_PATH) = True Then

Exit Function

End If

If Len(argERRORLOG_PATH) = 0 Then

Exit Function

End If

Set myFSO_Objeect = CreateObject("Scripting.FileSystemObject")

If myFSO_Objeect.FolderExists(argERRORLOG_PATH) = False Then

Exit Function

End If

Set myFSO_Objeect = Nothing

Open argERRORLOG_PATH & "\ErrLog.txt" For Output As #1

Print #1, Format(Now, "yyyy/mm/dd h:mm:ss")
Print #1, Application.OperatingSystem
Print #1, "Office " & Application.Version
Print #1, Err.Number
Print #1, Err.Description
Print #1, argSQL_COMMAND

Close #1

End Function

Dim myConvArray As Variant
Dim loop_X As Long

Dim myTemp As String

myTemp = "おは/よう/ござ" & Chr(10) & "います"

myConvArray = myfunct_SplitArray(myTemp)

MsgBox UBound(myConvArray)

For loop_X = 0 To UBound(myConvArray)

MsgBox myConvArray(loop_X)

Next loop_X

End Sub

Function myfunct_SplitArray(argCHARACTER As String) As Variant

'文字列に特定の文字が含まれていたら、その文字ごとに文字列値を分割し、配列変数に代入する

Const MAX_SPLITS As Integer = 255

Dim loop_X As Long
Dim loop_Y As Long

Dim myWord As String
Dim myChar As String '1文字づつ代入
Dim mySplitSets(MAX_SPLITS) As String '仮配列
Dim mySplitResults() As String '確定配列
Dim myCounter As Long '分割文字カウンター

myWord = argCHARACTER '対象文字列
myCounter = 0 '配列カウンター

For loop_X = 1 To Len(myWord)

Select Case Asc(StrConv(Mid(myWord, loop_X, 1), vbNarrow))

Case 10, 13, 47 '改行、またはスラッシュ

myCounter = myCounter + 1 '配列カウンター繰り上げ

myChar = "" '文字は無視

If myCounter = MAX_SPLITS Then '上限

GoTo FUNCT_SPI_ARR_RES

End If

Case Else

myChar = Mid(myWord, loop_X, 1) '文字を取得

End Select

mySplitSets(myCounter) = mySplitSets(myCounter) & myChar '取得した文字を、配列ごとの取得済み文字列と結合

Next loop_X

FUNCT_SPI_ARR_RES:

ReDim mySplitResults(myCounter) '確定配列の最大数を宣言

For loop_Y = 0 To myCounter '仮配列から確定配列へ、データを移植

mySplitResults(loop_Y) = mySplitSets(loop_Y)

Next loop_Y

Erase mySplitSets '仮配列初期化

myfunct_SplitArray = mySplitResults() '配列全体を返す

End Function

'NameList 抽出

strSQLCOMM = "SELECT IPL, CrewName, Unten, ActiveAvail, Note_CREW" & Chr(10) & _
"FROM " & "CREW_DAT" & Chr(10) & _
"WHERE ((bNickName)='" & myTargetCrew & "')" & Chr(10) & _
"ORDER BY Syozoku, RowID;"

boolFlag = funct_mdbSQL_Create(myMDB_FullName, "SCH_Notes2", strSQLCOMM)


Set myDB = OpenDatabase(myMDB_FullName)

'情報

Set myRECORD = myDB.OpenRecordset("SCH_Notes2")

With myRECORD

If .RecordCount > 0 Then

.MoveFirst

myInfo(0) = myRECORD(0).Value
myInfo(1) = myRECORD(1).Value
myInfo(2) = myRECORD(2).Value
myInfo(3) = myRECORD(3).Value
myInfo(4) = myRECORD(4).Value

End If

End With

Set myRECORD = Nothing

myDB.Close

Set myDB = Nothing

'分割用 確認完了

'汎用 Scheduleのデータエクスポートユニット

If Len(CREATE_DATABASE_FULLNAME) = 0 Or Len(SCHE_ADDRESS) = 0 Then

funct_RecordSet_SCHE = -1
Exit Function

End If

' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

'対象データベース

Dim myMDB_FullName As String

myMDB_FullName = CREATE_DATABASE_FULLNAME

' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Dim myDB As DAO.Database
Dim myRECORD As DAO.Recordset

Dim myMeiboRange As Range
Dim myMeiboaddress As String

myMeiboaddress = SCHE_ADDRESS

Dim strSQLCOMM As String
Dim myTmpCounter As Long
Dim varFlag As Variant

Set myDB = OpenDatabase(myMDB_FullName)

Set myRECORD = myDB.OpenRecordset(SCHE_DB)

Set myMeiboRange = Range(myMeiboaddress)

With myMeiboRange

For LoopEXPO = 1 To .Cells.Count


Select Case Len(WorksheetFunction.Substitute(CStr(.Cells(LoopEXPO).Value), Chr(EXCLUDE_HEADER_ASCII), Chr(0), 1))

' 先頭アンダーバーを除いた通称の文字数が、

Case 1 To ALLOW_NICKNAME_LEN ' 空白ではなく、制限文字数以内である場合のみ

' 正規データとして登録する

myTmpCounter = myTmpCounter + 1

myRECORD.AddNew

myRECORD(0).Value = myTmpCounter
myRECORD(1).Value = CStr(.Cells(LoopEXPO).Value)
myRECORD(2).Value = funct_GetRed(.Cells(LoopEXPO).Interior.Color)
myRECORD(3).Value = funct_GetGreen(.Cells(LoopEXPO).Interior.Color)
myRECORD(4).Value = funct_GetBlue(.Cells(LoopEXPO).Interior.Color)
myRECORD(5).Value = funct_GetRed(.Cells(LoopEXPO).Font.Color)
myRECORD(6).Value = funct_GetGreen(.Cells(LoopEXPO).Font.Color)
myRECORD(7).Value = funct_GetBlue(.Cells(LoopEXPO).Font.Color)
myRECORD(8).Value = funct_KAIGYOU_LETTER(.Cells(LoopEXPO).NoteText, True)
myRECORD(9).Value = .Cells(LoopEXPO).Address

varFlag = funct_StoreInfo(.Cells(LoopEXPO))

myRECORD(10).Value = varFlag(0)
myRECORD(11).Value = varFlag(1)
myRECORD(12).Value = varFlag(2)
myRECORD(13).Value = varFlag(3)

Erase varFlag

myRECORD.Update

End Select

Next


End With

Set myMeiboRange = Nothing

Set myRECORD = Nothing

myDB.Close

Set myDB = Nothing

funct_RecordSet_SCHE = myTmpCounter

End Function

'分割用 確認完了

'汎用 NameListのエクスポートユニット

' テンポラリ・データベースを作る → クルーリストのデータをレコードセット → 読み込んだクルーリストの件数を返す

If Len(CREATE_DATABASE_FULLNAME) = 0 Then

funct_CreateFLASH = Array(-1, -1, -1)
Exit Function

End If

Dim myMDB_FullName As String
myMDB_FullName = CREATE_DATABASE_FULLNAME

Dim myDB As DAO.Database
Dim myRECORD As DAO.Recordset
Dim myTBL As DAO.TableDef

Dim myCrewRows(0 To 2) As Long
Dim myCrewRange As Range

Dim myTMP_ADDRESS(1 To 2) As String
Dim LoopEXPO As Long

Dim myRegularRange As Range
Dim mytraineeRange As Range
Dim myTmpCounter As Long
Dim myActivateCrews(1 To 2) As Long

Dim LoopTables As Integer
Dim LoopLAND As Integer
Dim LoopCapt As Integer

Dim strNOTES(0 To 1) As String

Dim boolFlag As Boolean
Dim varFlag As Variant
Dim lngDB_RES As Long
Dim strSQLCOMM As String

'レギュラーの範囲


Set myCrewRange = ActiveWorkbook.Sheets(NAME_LIST_SHEET).Range("レギュラー")

With myCrewRange

myCrewRows(1) = .Cells(.Rows.Count, 2).End(xlUp).Row
myCrewRows(1) = myCrewRows(1) - 1


myTMP_ADDRESS(1) = Range(.Cells(1, 1), .Cells(myCrewRows(1), .Columns.Count)).Address

End With

Set myCrewRange = Nothing

'新人の範囲

Set myCrewRange = ActiveWorkbook.Sheets(NAME_LIST_SHEET).Range("新人")

With myCrewRange

myCrewRows(2) = .Cells(.Rows.Count, 2).End(xlUp).Row
myCrewRows(2) = myCrewRows(2) - 1

myTMP_ADDRESS(2) = Range(.Cells(1, 1), .Cells(myCrewRows(2), .Columns.Count)).Address

End With

Set myCrewRange = Nothing

' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

'DBを削除する

Set objTarget = CreateObject("Scripting.FileSystemObject")

If objTarget.FileExists(myMDB_FullName) = True Then

Kill myMDB_FullName

End If

Set objTarget = Nothing

'---------------------------------------------------------------------------

'新規作成

Set myDB = CreateDatabase(myMDB_FullName, dbLangJapanese)

myDB.Close

Set myDB = Nothing


'---------------------------------------------------------------------------

'テーブル定義

Set myDB = OpenDatabase(myMDB_FullName)

Set myTBL = myDB.CreateTableDef(SCHE_DB)

With myTBL

.Fields.Append .CreateField("SortID", dbInteger)
.Fields.Append .CreateField("NickName", dbText, 255)
.Fields.Append .CreateField("InteriorRed", dbInteger)
.Fields.Append .CreateField("InteriorGreen", dbInteger)
.Fields.Append .CreateField("InteriorBlue", dbInteger)
.Fields.Append .CreateField("FontRed", dbInteger)
.Fields.Append .CreateField("FontGreen", dbInteger)
.Fields.Append .CreateField("FontBlue", dbInteger)
.Fields.Append .CreateField("Note_SCHE", dbText, 255)
.Fields.Append .CreateField("SH_Address", dbText, 255)

.Fields("NickName").AllowZeroLength = True
.Fields("Note_SCHE").AllowZeroLength = True
.Fields("SH_Address").AllowZeroLength = True

' 追加
.Fields.Append .CreateField("InvDate", dbDouble)
.Fields.Append .CreateField("Departure", dbDouble)
.Fields.Append .CreateField("InvStore", dbText, 255)
.Fields.Append .CreateField("SVName", dbText, 255)

.Fields("InvStore").AllowZeroLength = True
.Fields("SVName").AllowZeroLength = True

End With


myDB.TableDefs.Append myTBL

Set myTBL = Nothing



Set myTBL = myDB.CreateTableDef(CREW_DB)

With myTBL

.Fields.Append .CreateField("Syozoku", dbInteger)
.Fields.Append .CreateField("RowID", dbLong)
.Fields.Append .CreateField("IPL", dbLong)
.Fields.Append .CreateField("CrewName", dbText, 255)
.Fields.Append .CreateField("bNickName", dbText, 255)
.Fields.Append .CreateField("Unten", dbText, 255)
.Fields.Append .CreateField("Kobetsu", dbText, 255)
.Fields.Append .CreateField("ActiveAvail", dbText, 255)
.Fields.Append .CreateField("Note_CREW", dbText, 255)
.Fields.Append .CreateField("EMail", dbText, 255)
.Fields.Append .CreateField("Phonetic", dbText, 255)

.Fields("CrewName").AllowZeroLength = True
.Fields("bNickName").AllowZeroLength = True
.Fields("Unten").AllowZeroLength = True
.Fields("Kobetsu").AllowZeroLength = True
.Fields("ActiveAvail").AllowZeroLength = True
.Fields("Note_CREW").AllowZeroLength = True
.Fields("EMail").AllowZeroLength = True
.Fields("Phonetic").AllowZeroLength = True

End With

myDB.TableDefs.Append myTBL



Set myTBL = myDB.CreateTableDef(ACTB_DB)

With myTBL

.Fields.Append .CreateField("Act_WorkBook", dbText, 255)
.Fields("Act_WorkBook").AllowZeroLength = True

End With

myDB.TableDefs.Append myTBL

' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
' _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/


' リストのインポート


Erase myActivateCrews


Set myRECORD = myDB.OpenRecordset(CREW_DB)

For LoopTables = 1 To 2

' 1回目 → レギュラー
' 2 → 新人

Set myCrewRange = ActiveWorkbook.Sheets(NAME_LIST_SHEET).Range(myTMP_ADDRESS(LoopTables))

With myCrewRange

For LoopEXPO = 1 To .Rows.Count

For LoopLAND = 1 To .Columns.Count

' ワークシート上にエラー値が存在する

If IsError(.Cells(LoopEXPO, LoopLAND).Value) = True Then

' エラーCallBackを返す

funct_CreateFLASH = Array(-3, -1, -1)

Set myCrewRange = Nothing
Set myRECORD = Nothing
Set myTBL = Nothing

myDB.Close

Set myDB = Nothing

Exit Function

End If

Next LoopLAND

Select Case True

Case (Val(.Cells(LoopEXPO, 1).Value) > 0) And (Len(.Cells(LoopEXPO, 2).Value) > 0) And (Len(.Cells(LoopEXPO, 3).Value) > 0)

myTmpCounter = myTmpCounter + 1

myRECORD.AddNew

myRECORD(0).Value = LoopTables
myRECORD(1).Value = .Cells(LoopEXPO, 1).Row
myRECORD(2).Value = Val(.Cells(LoopEXPO, 1).Value)
myRECORD(3).Value = CStr(.Cells(LoopEXPO, 2).Value)
myRECORD(4).Value = CStr(.Cells(LoopEXPO, 3).Value)
myRECORD(5).Value = CStr(.Cells(LoopEXPO, 4).Value)
myRECORD(6).Value = CStr(.Cells(LoopEXPO, 5).Value)
myRECORD(7).Value = CStr(.Cells(LoopEXPO, 6).Value)

If Len(myRECORD(7).Value) > 0 Then

myActivateCrews(LoopTables) = myActivateCrews(LoopTables) + 1

End If


' 全配列のコメントを取得する
Erase strNOTES

For LoopLAND = 1 To .Columns.Count

strNOTES(1) = CStr(.Cells(LoopEXPO, LoopLAND).NoteText)

If Len(strNOTES(0)) = 0 And Len(strNOTES(1)) > 0 Then

strNOTES(0) = strNOTES(1)

ElseIf Len(strNOTES(0)) > 0 And Len(strNOTES(1)) > 0 Then

strNOTES(0) = strNOTES(0) & CONV_CR_LETTER & strNOTES(1)

End If

Next LoopLAND


strNOTES(0) = funct_KAIGYOU_LETTER(strNOTES(0), True) '改行を $ に置き換える（データベースの障害防止）
myRECORD(8).Value = strNOTES(0)


' メアド
myRECORD(9).Value = CStr(.Cells(LoopEXPO, 7).Value)


myRECORD.Update

Erase strNOTES


End Select

Next


End With

Set myCrewRange = Nothing

Next LoopTables

Set myRECORD = Nothing
Set myTBL = Nothing



' ワークブック名

Set myRECORD = myDB.OpenRecordset(ACTB_DB)

With myRECORD

.AddNew

myRECORD(0).Value = ActiveWorkbook.Name

.Update

End With

Set myRECORD = Nothing

myDB.Close

Set myDB = Nothing

' _-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~_-~

' NameList 重複チェック

' 必須項目の重複を排除する

' ① IPL重複抽出クエリ

strSQLCOMM = "SELECT IPL" & Chr(10) & _
"FROM " & CREW_DB & Chr(10) & _
"GROUP BY IPL" & Chr(10) & _
"HAVING (((Count(Syozoku))>1));"


boolFlag = funct_mdbSQL_Create(myMDB_FullName, CREW_DB_CHK1, strSQLCOMM)

' ② 通称重複抽出クエリ

strSQLCOMM = "SELECT bNickName" & Chr(10) & _
"FROM " & CREW_DB & Chr(10) & _
"GROUP BY bNickName" & Chr(10) & _
"HAVING (((Count(Syozoku))>1));"


boolFlag = funct_mdbSQL_Create(myMDB_FullName, CREW_DB_CHK2, strSQLCOMM)

' ③ EMail重複抽出クエリ

strSQLCOMM = "SELECT EMail" & Chr(10) & _
"FROM " & CREW_DB & Chr(10) & _
"GROUP BY EMail" & Chr(10) & _
"HAVING (((Count(Syozoku))>1));"


boolFlag = funct_mdbSQL_Create(myMDB_FullName, CREW_DB_CHK3, strSQLCOMM)


' ④ 通称の文字列

strSQLCOMM = "SELECT bNickName" & Chr(10) & _
"FROM " & CREW_DB & Chr(10) & _
"GROUP BY bNickName" & Chr(10) & _
"HAVING (((Len(bNickName))>" & ALLOW_NICKNAME_LEN & "));"


boolFlag = funct_mdbSQL_Create(myMDB_FullName, CREW_DB_CHK4, strSQLCOMM)

' ⑤ 新規テーブルを作って、IPL重複レコードを追加する

strSQLCOMM = "SELECT " & CREW_DB & ".IPL, CrewName AS 氏名, bNickName AS 通称, EMail, " & _
"IIf([Syozoku] Is Null,'','') AS 通称_Len, " & _
"IIf([Syozoku] Is Null,'●','●') AS IPL_Dup, " & _
"IIf([Syozoku] Is Null,'','') AS 通称_Dup, " & _
"IIf([Syozoku] Is Null,'','') AS EMail_Dup" & _
" INTO " & CREW_ERR_DB & Chr(10) & _
"FROM " & CREW_DB & _
" LEFT JOIN " & CREW_DB_CHK1 & _
" ON " & CREW_DB & ".IPL = " & CREW_DB_CHK1 & ".IPL" & Chr(10) & _
"WHERE (((" & CREW_DB_CHK1 & ".IPL) Is Not Null));"

lngDB_RES = funct_mdbSQL_NEWTBL(myMDB_FullName, strSQLCOMM, CREW_ERR_DB)

' ⑥ 通称重複レコードを、⑤のテーブルに追加する

strSQLCOMM = "INSERT INTO " & CREW_ERR_DB & " ( IPL, 氏名, 通称, EMail, 通称_Len, IPL_Dup, 通称_Dup, EMail_Dup )" & Chr(10) & _
"SELECT IPL, CrewName AS 氏名, " & CREW_DB & ".bNickName AS 通称, EMail, " & _
"IIf([Syozoku] Is Null,'','') AS 通称の文字数, " & _
"IIf([Syozoku] Is Null,'','') AS IPL重複, " & _
"IIf([Syozoku] Is Null,'●','●') AS 通称重複, " & _
"IIf([Syozoku] Is Null,'','') AS EMail重複" & Chr(10) & _
"FROM " & CREW_DB & _
" LEFT JOIN " & CREW_DB_CHK2 & _
" ON " & CREW_DB & ".bNickName = " & CREW_DB_CHK2 & ".bNickName" & Chr(10) & _
"WHERE (((" & CREW_DB_CHK2 & ".bNickName) Is Not Null));"

lngDB_RES = lngDB_RES + funct_mdbSQL_ADDON(myMDB_FullName, strSQLCOMM, CREW_ERR_DB)

' ⑦ EMail重複レコードを、⑤のテーブルに追加する

strSQLCOMM = "INSERT INTO " & CREW_ERR_DB & " ( IPL, 氏名, 通称, EMail, 通称_Len, IPL_Dup, 通称_Dup, EMail_Dup )" & Chr(10) & _
"SELECT IPL, CrewName AS 氏名, bNickName AS 通称, " & CREW_DB & ".EMail, " & _
"IIf([Syozoku] Is Null,'','') AS 通称の文字数, " & _
"IIf([Syozoku] Is Null,'','') AS IPL重複, " & _
"IIf([Syozoku] Is Null,'','') AS 通称重複, " & _
"IIf([Syozoku] Is Null,'●','●') AS EMail重複" & Chr(10) & _
"FROM " & CREW_DB & _
" LEFT JOIN " & CREW_DB_CHK3 & _
" ON " & CREW_DB & ".EMail = " & CREW_DB_CHK3 & ".EMail" & Chr(10) & _
"WHERE (((IIf([" & CREW_DB & "].[EMail] Is Null Or Len([" & CREW_DB & "].[EMail])=0,0,1))=1)" & _
" AND ((" & CREW_DB_CHK3 & ".EMail) Is Not Null));"

lngDB_RES = lngDB_RES + funct_mdbSQL_ADDON(myMDB_FullName, strSQLCOMM, CREW_ERR_DB)

' ⑧ 通称の制限文字列オーバーを、⑤のテーブルに追加する

strSQLCOMM = "INSERT INTO " & CREW_ERR_DB & " ( IPL, 氏名, 通称, EMail, 通称_Len, IPL_Dup, 通称_Dup, EMail_Dup )" & Chr(10) & _
"SELECT IPL, CrewName AS 氏名, " & CREW_DB & ".bNickName AS 通称, " & CREW_DB & ".EMail, " & _
"IIf([Syozoku] Is Null,'" & ALLOW_NICKNAME_LEN & "文字以下に','" & ALLOW_NICKNAME_LEN & "文字以下に') AS 通称の文字数, " & _
"IIf([Syozoku] Is Null,'','') AS IPL重複, " & _
"IIf([Syozoku] Is Null,'','') AS 通称重複, " & _
"IIf([Syozoku] Is Null,'','') AS EMail重複" & Chr(10) & _
"FROM " & CREW_DB & _
" LEFT JOIN " & CREW_DB_CHK4 & _
" ON " & CREW_DB & ".bNickName = " & CREW_DB_CHK4 & ".bNickName" & Chr(10) & _
"WHERE (((" & CREW_DB_CHK4 & ".bNickName) Is Not Null));"

lngDB_RES = lngDB_RES + funct_mdbSQL_ADDON(myMDB_FullName, strSQLCOMM, CREW_ERR_DB)

' ⑨ 最終エラーリスト

strSQLCOMM = "SELECT IPL, 氏名, 通称, EMail, Max(通称_Len) AS 通称の文字数, Max(IPL_Dup) AS IPL重複, Max(通称_Dup) AS 通称重複, Max(EMail_Dup) AS EMail重複" & Chr(10) & _
"FROM " & CREW_ERR_DB & Chr(10) & _
"GROUP BY IPL, 氏名, 通称, EMail;"

boolFlag = funct_mdbSQL_Create(myMDB_FullName, CREW_ERR_XLS, strSQLCOMM)

If lngDB_RES > 0 Then

' 何かしらの重複レコードがある場合

' 新規ブックにエラーリストを作る

Workbooks.Add
Sheets(1).Select

strSQLCOMM = "SELECT *" & Chr(10) & "FROM " & CREW_ERR_XLS
varFlag = funct_SQL_ODBC(dirODBC(1) & ODBC_FLASH, "A1", strSQLCOMM, True, True)

' エラーCallBackを返す

funct_CreateFLASH = Array(-2, -1, -1)

Else

' 取得結果のCallBackを返す

' 戻り値

'総登録人数 レギュラー 新人
funct_CreateFLASH = Array(myTmpCounter, myActivateCrews(1), myActivateCrews(2))

End If

End Function