배열, 레코드셋 이용해서 테이블 필드추가하기 VBA

안녕하세요. 코드 메모 입니다. 필요하신 분은 보시고 응용해보세요. (경어 신경쓰지 않고 봐주세요. 저를 위해서 편하게 작성합니다.)

 

오늘 메모할 내용은

프로그램 사용중에 미래에 나올 내용에 대해서 자동적으로 필드를 추가하는 간단한(?) 내용임.

 

 

 

Q. 매출 테이블은 지속적으로 작성하기에 날짜는 계속 증가되고, 미리 작성한 통계 테이블은 어느 순간 다음해의 필드가 필요해지는 상황이 발생함. 

(상단 그림은 '대략의 매출 테이블이 있다' 정도로 이해해주시고, 하단 그림은 작년에 만들었다면 23년까지 필드가 있을텐데, 한 해가 지나서 24년 이되면 2024 필드가 필요하는 얘기임)

 

 

폼에 버튼을 만들고 클릭이벤트를 넣어서 한번에 되게끔 이어 갈겁니다.

 

* 클릭이벤트에 여러가지 프로시저를 순차적으로 진행하는 형식으로 만들어, 최종목적에 도달하는데 이 포스트는 위에 설명한 내용까지만 작성

 

아래 코드의 내용은 테이블이 없으면 테이블을 만들고, 테이블이 있으면 없는 년을 추가하라는 코드입니다.

이후 추가할 내용은 월을 넣고, 매출액 통계를 내서 테이블에 집어 넣는 코드를 개별 프로시저로 붙여 삽입하면 됩니다.

* 가장 중요한 조건은 내가 23년까지 통계 필드가 있는데 지금 24년인지 어떻게 아느냐 인데, 그 조건을 매출테이블에 24년이 있고, 통계테이블에 24년이 없다면 24년을 넣겠다라는 내용입니다.

 

Option Compare Database
Option Explicit
'-------------------------------
Private Sub Command0_Click()
메인차트테이블
End Sub
'-------------------------------
Private Sub 메인차트테이블()

Dim tbn As String
tbn = "매출통계"
   
If TableExists(tbn) = False Then
    매출TBC (tbn)
Else
    매출TBCA (tbn)
End If
    
End Sub
'-------------------------------
Public Function TableExists(tableName As String) As Boolean
    Dim DB As Database
    Set DB = CurrentDb
    
    Dim tdf As TableDef
    For Each tdf In DB.TableDefs
        If tdf.Name = tableName Then
            TableExists = True
            Exit Function
        End If
    Next tdf
    TableExists = False
    
    DB.Close
    Set DB = Nothing

End Function
'-------------------------------
Private Sub 매출TBCA(tbn As String)
Dim DB As DAO.Database
Dim tbl As DAO.TableDef
Dim fld As DAO.field

Dim strSQL As String, RS As DAO.Recordset, 년도a As String, j As Long, 년도b As Variant
Dim i As Integer, AR() As Variant, k As Integer
ReDim AR(0 To 0)

Set DB = CurrentDb
Set tbl = DB.TableDefs("매출테이블")
 


    For Each fld In tbl.Fields
    If fld.Name <> "ID" And fld.Name <> "월" Then
        
     
     AR(UBound(AR)) = fld.Name
     ReDim Preserve AR(0 To UBound(AR) + 1)
    
    End If
    Next fld
 

    ' 마지막에 추가된 불필요한 배열 요소 제거
    ReDim Preserve AR(0 To UBound(AR) - 1)
    
   '     For i = LBound(AR) To UBound(AR)
   '     Debug.Print "Field Name: " & AR(i)
   '     Next i
    
Dim found As Boolean
 
strSQL = "SELECT Format([날짜],'yyyy') AS 날짜a FROM 매출테이블 GROUP BY Format([날짜],'yyyy')"
Set RS = DB.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
If RS.recordCount Then
RS.MoveFirst
Do

    년도a = RS!날짜a
    found = False
    For i = LBound(AR) To UBound(AR)
        If AR(i) = RS!날짜a Then
        found = True
        Exit For
        End If
    
    Next i
    
    If found = False Then
    
        With tbl.Fields
        .Append tbl.CreateField("" & 년도a & "", dbLong)
        End With
        
    End If
       
RS.MoveNext
Loop Until RS.EOF
End If

Set RS = Nothing

    ' 객체 해제
Set fld = Nothing
Set tbl = Nothing
Set DB = Nothing
    

End Sub
'-------------------------------
Private Sub 매출TBC(tbn As String)
 Dim DB As DAO.Database
    Dim tbl As DAO.TableDef

     Set DB = CurrentDb()
    Set tbl = DB.CreateTableDef(tbn)


    ' 필드 추가

    With tbl.Fields

        .Append tbl.CreateField("ID", dbLong)

' --------필드부분만 수정해서 사용--------------

If tbn = "매출통계" Then

        .Append tbl.CreateField("월", dbText)

Dim strSQL As String, RS As DAO.Recordset, 년도a As String

strSQL = "SELECT Format([날짜],'yyyy') AS 날짜a FROM 매출테이블 GROUP BY Format([날짜],'yyyy')"
Set RS = DB.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
If RS.recordCount Then
RS.MoveFirst
Do
    년도a = RS!날짜a
    .Append tbl.CreateField("" & 년도a & "", dbLong)
    
RS.MoveNext
Loop Until RS.EOF
End If

Set RS = Nothing


End If

'--------필드부분만 수정해서 사용--------------(끝)
    End With

    ' 자동증가, 필수설정
    tbl.Fields("ID").Attributes = dbAutoIncrField
    tbl.Fields("ID").Required = True


    ' 새로운 "PrimaryKey" 인덱스 생성
    Dim idx As Index
    Set idx = tbl.CreateIndex("PrimaryKey")
    With idx
        .Fields.Append .CreateField("ID")
        .Primary = True
    End With
    tbl.Indexes.Append idx

    ' 테이블을 추가하고 정리하다

    DB.TableDefs.Append tbl

    Set tbl = Nothing
    Set DB = Nothing

    ' 생성된 테이블을 활성화

    DoCmd.SelectObject acTable, tbn, True
End Sub