魚山田のブログ -9ページ目

魚山田のブログ

ブログの説明を入力します。

Function funct_RecordSet_SCHE(CREATE_DATABASE_FULLNAME As String, SCHE_ADDRESS As String) As Long


'分割用 確認完了


'汎用 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