Const Top_Title = "◈ Datagod Excel ◈"
Sub Excel_Get()
Dim rngDb As DAO.Database '같은 파일의 Sheet 내용 불러올때
Dim rngRs As DAO.Recordset '같은 파일의 Sheet 내용 불러올때
Dim Con As ADODB.Connection '다른 폴더 파일의 Sheet 내용 불러올때
Dim RS As ADODB.Recordset '다른 폴더 파일의 Sheet 내용 불러올때
Dim SQL As String
Dim rngSheet As Worksheet
Dim i As Double
Dim SR As Double
Dim SHN As Double
Application.ScreenUpdating = False '화면 갱신을 숨기구
intNum = Worksheets("EXCEL_SQL").UsedRange.Rows.Count '세로행의 갯수
For SR = 1 To (intNum - 1)
SHN = SR + 1
Sheet_Name = Worksheets("EXCEL_SQL").Cells(SHN, 1) ' Sheet Name 위치
File_Type = Worksheets("EXCEL_SQL").Cells(SHN, 2) ' File Type
File_Route = Worksheets("EXCEL_SQL").Cells(SHN, 3) ' File 경로 및 이름
Sheet_SQL = Worksheets("EXCEL_SQL").Cells(SHN, 4) ' SQL 위치
Sheet_Use = Worksheets("EXCEL_SQL").Cells(SHN, 5) ' 사용여부
If Sheet_Use = "Sheet Create" Then
For Each rngSheet In Worksheets ' Sheet 명을 찾아서 지운다
If rngSheet.Name = Sheet_Name Then
Application.DisplayAlerts = False ' 기존 Sheet 삭제시 팝업창 제거
rngSheet.Delete
Application.DisplayAlerts = True
End If
Next rngSheet
Worksheets.Add.Name = Sheet_Name ' Sheet 명을 생성한다
'팝업창 설정
'팝업창 설정
Pop_Message = Pop_Message & vbCr & vbCr & "◈ " & Sheet_Name & " sheet has been created successfully !! ◈"
ElseIf Sheet_Use = "Data Call" Then
For Each rngSheet In Worksheets
If rngSheet.Name = Sheet_Name Then
Sheets(Sheet_Name).Select '해당하는 Sheet 를 선택하고요
rngSheet.Range("A1:Z1000000").ClearContents '기존 내용이 있으면 일단 다 지워라
'####### 경로및 파일명 설정
'####### 경로및 파일명 설정
If File_Type = "Folder" And File_Route <> "" Then
'***** 해당 파일을 닫고 나서 실행을 시킨다
SQL = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & File_Route & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
Set Con = New ADODB.Connection
Con.Open SQL
SQL = Sheet_SQL
Set RS = Con.Execute(SQL)
With ActiveSheet
For i = 0 To RS.Fields.Count - 1 '필드명을 순환해
Cells(1, i + 1).Value = RS.Fields(i).Name '첫열에다 필드명을 뿌려주고
Next
.Range("A2").CopyFromRecordset RS 'A2부터 뿌려주고
.UsedRange.Columns.AutoFit '열 자동맟추고
End With
RS.Close
Con.Close
'기타 설정들
'틀고정 & 가운데정렬 & 셀 색깔
Sheets(Sheet_Name).Select
Range("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.AutoFilter
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 85
'기타 설정들
'틀고정 & 가운데정렬 & 셀 색깔
ElseIf File_Type = "Sheet" Then
'같은 파일내의 바로 옆의 Sheet 내용을 불러올때
Set rngDb = OpenDatabase(ThisWorkbook.FullName, False, False, "Excel 8.0;")
SQL = Sheet_SQL '쿼리를 불러오고
Set rngRs = rngDb.OpenRecordset(SQL) 'SQL 을 실행시키고요
With ActiveSheet
For i = 0 To rngRs.Fields.Count - 1 '필드명을 순환해
Cells(1, i + 1).Value = rngRs.Fields(i).Name '첫열에다 필드명을 뿌려주고
Next
.Range("A2").CopyFromRecordset rngRs 'C2부터 뿌려주고
.UsedRange.Columns.AutoFit '열 자동맟추고
End With
rngRs.Close '레코드셋을 닫어주고
rngDb.Close
'기타 설정들
'틀고정 & 가운데정렬 & 셀 색깔
Sheets(Sheet_Name).Select
Range("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.AutoFilter
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 85
'기타 설정들
'틀고정 & 가운데정렬 & 셀 색깔
End If
'####### 경로및 파일명 설정
'####### 경로및 파일명 설정
End If
Next rngSheet
'팝업창 설정
'팝업창 설정
If File_Type = "Folder" And File_Route <> "" Then
Pop_Message = Pop_Message & vbCr & vbCr & "◈ " & Sheet_Name & " data has been called successfully !! ◈"
ElseIf File_Type = "Folder" And File_Route = "" Then
MsgBox "◈ You have to " & Sheet_Name & " sheet input file route !! ◈", 16, Top_Title
ElseIf File_Type = "Sheet" And File_Route = "" Then
Pop_Message = Pop_Message & vbCr & vbCr & "◈ " & Sheet_Name & " data has been called successfully !! ◈"
End If
Set rngRs = Nothing '개체메모리는 제거해 주고
Set rngDb = Nothing
Set RS = Nothing
Set Con = Nothing
End If
Next SR
'팝업창 설정
'팝업창 설정
Pop_Message = Pop_Message & vbCr & vbCr & vbCr & " http://datagod.tistory.com"
MsgBox Pop_Message, vbInformation, Top_Title
'화면갱신 해제.. 메세지 박스 나타낼려면 미리..^^*
Application.ScreenUpdating = True
End Sub
- Report 보기 : http://datagod.tistory.com/46
 |
|
엑셀과 Excel 연결 VBA Source.txt
 |
