'NIFTY Manager for Windows 3.1 の会議室キャビネットを
'ログファイルにエクスポートするマクロ

' 実行例
' CabinetExport "C:\NIFTY\FCABINET\CABINET0.001\FOLDER0.002", _
'     "D:\NIFTY\LOG\MES11.LOG", "*.msg"

Option Explicit

Type InputRecord
    i101 As String * 1
    i102 As String * 1
    i2 As Integer
    i3 As Integer
    i4 As Integer
    i5 As Long
    a6 As String * 8
    i7 As Integer
    a8 As String * 18
    a9 As String * 42
    i10 As Integer
    i11 As Integer
    a12 As String * 500
End Type

Type Header1
    a1 As String * 5
    s2 As String * 1
    a3 As String * 5
    s4 As String * 1
    a5 As String * 8
    s6 As String * 2
    a7 As String * 16
    a8 As String * 1
    a9 As String * 40
End Type

Type Header2
    s1 As String * 1
    a2 As String * 2
    s3 As String * 2
    s4 As String * 2
    a5 As String * 8
    s6 As String * 1
    a7 As String * 5
    s8 As String * 2
    a9 As String * 5
    s10 As String * 12
    s11 As String * 2
    s12 As String * 12
    a13 As String * 2
End Type

Sub CabinetExport(cabnetFolder As String, _
        o_fileName As String, fileType As String)
    Dim i_rec As InputRecord
    Dim o_rec1 As Header1
    Dim o_rec2 As Header2
    Dim i_fname As String
    Dim i_fno As Integer
    Dim o_fno As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim s1 As String, s2 As String
    Dim c1 As String * 12, c2 As String * 12
    Dim day1 As Long
    Dim hour1 As Integer
    Dim minu1 As Integer
    Dim scnd As Long
    Dim date1 As Double
    Dim str1 As String * 586
    Dim str2 As String
    Dim cnt As Integer

    cnt = 0
    o_rec1.s2 = "/"
    o_rec1.a3 = "00000"
    o_rec1.s4 = " "
    o_rec1.s6 = "  "
    o_rec1.a8 = " "

    o_rec2.s1 = "("
    o_rec2.s3 = ") "
    o_rec2.s4 = "  "
    o_rec2.s6 = " "
    o_rec2.s8 = "  "
    o_rec2.s11 = "  "

    c1 = "へのコメント"
    c2 = "コメント数："

    If Right$(cabnetFolder, 1) <> "\" Then _
        cabnetFolder = cabnetFolder & "\"

    i_fname = Dir$(cabnetFolder & fileType)
    If i_fname = "" Then Exit Sub

    On Error GoTo err_1
    o_fno = FreeFile()
    Open o_fileName For Output As #o_fno

    Do While i_fname <> ""
        j = (FileLen(cabnetFolder & i_fname) _
            + Len(i_rec) - 1) \ Len(i_rec)
        i_fno = FreeFile()
        Open cabnetFolder & i_fname For Random _
            As #i_fno Len = Len(i_rec)
        Get #i_fno, 1, i_rec
        str2 = i_rec.a12

        For i = 2 To j
            Get #i_fno, i, str1
            str2 = str2 & str1
        Next
        Close #i_fno

        day1 = (i_rec.i5 + 32400) \ 86400
        date1 = DateValue("1970/01/01") + day1
        scnd = i_rec.i5 + 32400 - day1 * 86400
        hour1 = scnd \ 3600
        minu1 = (scnd Mod 3600) \ 60

        o_rec1.a1 = Format$(i_rec.i2, "00000")
        o_rec1.a5 = i_rec.a6
        o_rec1.a7 = i_rec.a8

        s1 = Trim$(i_rec.a9)
        s2 = ""
        i = 1
        j = 1
        Do While j > 0
            j = InStrB(i, s1, Chr$(0))
            If j > 0 Then
                s2 = s2 & MidB$(s1, i, j - i)
                i = j + 1
            End If
        Loop
        o_rec1.a9 = s2

        o_rec2.a2 = Format$(Asc(i_rec.i102), "00")
        o_rec2.a5 = Format$(date1, "yy/mm/dd")
        o_rec2.a7 = Format$(hour1, "00") & ":" & Format$(minu1, "00")
        If i_rec.i3 > 0 Then
           o_rec2.a9 = Format$(i_rec.i3, "00000")
           o_rec2.s10 = c1
        Else
            o_rec2.a9 = ""
            o_rec2.s10 = ""
        End If
        Print #o_fno, o_rec1.a1 & o_rec1.s2 & o_rec1.a3 & _
            o_rec1.s4 & o_rec1.a5 & o_rec1.s6 & o_rec1.a7 & _
            o_rec1.a8 & Trim$(o_rec1.a9)
        Print #o_fno, Trim$(o_rec2.s1 & o_rec2.a2 & o_rec2.s3 & _
            o_rec2.s4 & o_rec2.a5 & o_rec2.s6 & o_rec2.a7 & _
            o_rec2.s8 & o_rec2.a9 & o_rec2.s10 & o_rec2.s11)
        Print #o_fno, ""

        j = InStrB(1, str2, Chr$(0))
        If j > 0 Then
            k = LenB(str2)
            For i = j To k
                If MidB$(str2, i, 1) = Chr$(0) Then MidB$(str2, i, 1) = " "
            Next
        End If
        s1 = Trim$(str2)
        s2 = ""
        i = 1
        j = 1
        Do While j > 0
            j = InStrB(i, s1, Chr$(10))
            If j > 0 Then
                s2 = s2 & MidB$(s1, i, j - i) & Chr$(13) & Chr$(10)
                i = j + 1
            Else
                s2 = s2 & MidB$(s1, i)
                Exit Do
            End If
        Loop

        Print #o_fno, s2
        cnt = cnt + 1
        i_fname = Dir$()
    Loop
    Close #o_fno
    MsgBox cnt & "件 エクスポートしました。", , "CabinetExport"
    Exit Sub

err_1:
    Close #o_fno
    Close #i_fno
    MsgBox "エラーが発生しました", , "CabinetExport"
    Exit Sub
End Sub