| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 액세스 버전(2007-2016):
* 아래줄에 질문을 작성하세요 >>
아래 코드는 access의 테이블 레코드를 excel 파일로 옮기는 내용입니다. 일전에 황동준님께서 알려주신 코드를 변형해서 현재까지 잘 사용하고 있는 중입니다.
그런데 두 가지 기능을 추가하고 싶은데 어려움이 있어 문의드립니다.
첫번째는, access에서 excel로 옮기기 전에, excel 파일이 열려있는지 닫혀있는지를 확인하고 열려있으면 닫아야 하는 기능입니다.
이 기능이 필요한 이유는, excel 파일이 열려있는 상태로 아래 코드를 실행하면, excel 자제 내장기능에 의하여 '이미 파일이 존재한다'는 메시지가 나오면서 '다른이름으로 저장'을 요구합니다. 그렇게 되면 제가 원하는 작업인, 기존 excel 파일에 레코드를 추가하는 작업이 안 되기 때문입니다. 그래서 레코드를 옮기기 전에 excel파일을 미리 닫는 코드를 추가해 봤습니다. 중간에 '*** 파일이 있으면 닫기' 아래줄 입니다. 그런데 코드를 실행하면 열여있는 excel 파일이 닫히지 않습니다. 몇 가지 다른 시도를 해 보았지만 해결책을 찾지 못하고 있습니다. 어떻게 하며 될까요?
두번째는, excel 파일이 '읽기전용'으로 열리는 경우가 가끔 발생합니다.
어쩌면 첫번째와 연계된 문제인 것 같기도 합니다. 원인을 모르게 불규칙적으로 발생하는데, 한번 '읽기전용'으로 열리면 MsOffice에서 제공하는 다양한 시도를 해도 '읽기전용'이 해지되지 않습니다. 그런데 컴을 켰다 켜면 '읽기전용'이 사라집니다. '*** 파일이 있으면 닫기' 아래줄 코드가 실행되면서 뭔가 충돌이 발생하는 것으로 보입니다. 그래서 excel 파일이 '읽기전용'으로 되지 않게 하는 방법을 알고 싶습니다.
다양한 시도를 해 보았지만 해결하지 못하여 도움을 요청드립니다.
Dim xlApp As Object 'Excel Application
Dim xlWB As Object 'WorkBooks
Dim xlSheet As Object 'sheet
Dim filePath As String '파일 경로
Dim db As DAO.Database
Dim rs주문3발송PO As DAO.Recordset 'tbl주문3발송PO 테이블
Dim rs주문3발송HP As DAO.Recordset 'tbl주문3발송HP 테이블
Dim lastRow As Long
Dim i As Integer
Dim xYN As String
filePath = "E:\Q_MyStudy\II_Programing\A_우체국송장 출력\우체국업로드용.xlsx"
' 엑셀 애플리케이션 객체 생성
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If Dir(filePath) = "" Then '파일이 있는데 찾지 못함
xYN = MsgBox("우체국 업로드용 파일을 찾지 못했습니다!" _
& vbCrLf _
& "새 업로드용 파일 만들기에 동의하십니까?", vbYesNo + vbCritical)
If xYN <> 6 Then
MsgBox "작업을 종료합니다."
Set xlApp = Nothing
Exit Sub
End If
' 파일이 없으면 새로 생성
Set xlWB = xlApp.Workbooks.Add
xlWB.SaveAs filePath
Else
' *** 파일이 열려있으면 닫기
Set xlWB = xlApp.activeWorkbooks.Close(filePath) '작업 후 엑셀 파일이 읽기 전용으로만 열림. 고쳐지지 않음. 컴을 다시 켜자 해지됨.
' 파일이 있으면 열기
Set xlWB = xlApp.Workbooks.Open(filePath)
End If
' 첫 번째 시트 선택
Set xlSheet = xlWB.Sheets(1)
' 마지막 행 찾기
If xlSheet.Cells(1, 1).Value = "" Then
lastRow = 1
Else
lastRow = xlSheet.Cells(xlSheet.Rows.Count, 1).End(-4162).Row + 1
End If
' Access 데이터베이스와 Recordset 설정
Set db = CurrentDb
Set rs주문3발송PO = db.OpenRecordset("tbl주문3발송PO") 'AI는 쿼리명을 요구했으나 테이블명 입력했음
' 필드 이름 추가 (첫 번째 행)
If lastRow = 1 Then
For i = 0 To rs주문3발송PO.Fields.Count - 1
xlSheet.Cells(lastRow, i + 1).Value = rs주문3발송PO.Fields(i).Name
Next i
lastRow = lastRow + 1
End If
' 데이터 추가 (Recordset 내용 반복)
Do While Not rs주문3발송PO.EOF
For i = 0 To rs주문3발송PO.Fields.Count - 1
xlSheet.Cells(lastRow, i + 1).Value = rs주문3발송PO.Fields(i).Value
Next i
lastRow = lastRow + 1
rs주문3발송PO.Delete '엑셀로 옮긴 후 삭제
rs주문3발송PO.Update 'MoveNext 하기 전에 Update하여 오류 발생 여부 체크
rs주문3발송PO.MoveNext
Loop
' Recordset 닫기
rs주문3발송PO.Close
Set rs주문3발송PO = Nothing
Set db = Nothing
' 파일 저장 및 닫기
xlWB.Save
xlWB.Close
xlApp.Quit
' 메모리 해제
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
MsgBox "데이터 내보내기가 완료되었습니다!"
==============[이형재님 글에 대한 답변입니다]==============
읽기전용으로 열리는 이유는 이미 해당 파일이 열려있는 상태에서 두번째로 열려서 그런 것 같습니다.
A.I를 활용한 답변입니다. 아래 참조 후 알맞게 적용하세요.
filePath = "E:\Q_MyStudy\II_Programing\A_우체국송장 출력\우체국업로드용.xlsx"
' 엑셀 애플리케이션 객체 생성
Set xlApp = GetObject(, "Excel.Application") ' Excel Application 가져오기
If xlApp Is Nothing Then
' Excel이 실행 중이 아닌 경우 새 인스턴스 시작
Set xlApp = CreateObject("Excel.Application")
End If
'파일이 열려 있는지 확인하고 열려있다면 저장 후 닫기
Dim fileOpened As Boolean
fileOpened = False
For Each xlWB In xlApp.Workbooks
If xlWB.FullName = filePath Then
fileOpened = True
xlWB.Save
xlWB.Close
Exit For
End If
Next xlWB
' 파일 다시 열기
xlApp.Visible = True
xlApp.Workbooks.Open filePath
'확인
If fileOpened = True Then
MsgBox "열려있는 파일을 저장하고 닫은 후 다시 열었습니다!"
ElseIf fileOpened = False Then
MsgBox "파일을 열었습니다!"
End If |
|
액세스에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
