VBA FILE DOWNLOAD 오류

Question

웹서버에 xlsm 파일을 바탕화면으로 받아오는 코드를 연습중인데 받아오는건 성공했으나 파일이 손상되어 열리지가 않습니다. 어디를 수정해야할까요 main methodSub download_Files_From_Web() Dim rngC As Range '각 셀을 넣을 변수 Dim strPath As String '저장 폴더의 경로를 넣을 변수 Dim sUrl As String '설치url Dim filename As String '파일이름(확장자포함) 넣을 변수 strPath = "C:\Users\" & Environ("username") & "\Desktop\" '화면 업데이트 (일시)중단 If Len(Dir(strPath)) = 0 Then MkDir strPath End If sUrl = "http://atotrading.iptime.org/unit_price_program/1_0_0_1/수입단가비교프로그램(원가계산).xlsm" '------------------------------------------------------------------------------------- filename = Mid(sUrl, InStrRev(sUrl, "/") + 1, _ Len(sUrl) - InStrRev(sUrl, "/")) '파일이름과 확장자만 추출 downLoad_File sUrl, strPath & filename '파일을 다운받아 저장하는 함수 호출 filename = Dir(strPath & "*.*") While filename <> "" If Split(filename, ".")(1) = "티느" Then Dim strName(1) As String On Error Resume Next strName(0) = Mid(filename, InStrRev(filename, "/") + 1, _ Len(filename) - InStrRev(filename, "/")) '파일이름과 확장자만 추출 strName(1) = "수입단가비교프로그램(원가계산).xlsm" Name strPath & strName(0) As strPath & strName(1) End If filename = Dir() Wend Dim myWk As Workbook: Set myWk = ActiveWorkbook filename = Mid(sUrl, InStrRev(sUrl, "/") + 1, _ Len(sUrl) - InStrRev(sUrl, "/")) '파일이름과 확장자만 추출 Workbooks.Open strPath & filename newWk.Activate myWk.Close End Sub실제 다운로드 함수( 다운로드 설치 url, 다운로드 설치할 경로) Function downLoad_File(ByVal strWeb As String, ByVal strCom As String) As Boolean '웹 전체경로 및 컴퓨터에 저장될 경로와 작업중인셀을 넣을 변수들 Dim objXMLHTTP As Object 'XMLHTTP를 넣을 개체 Dim msg As String '메시지 넣을 변수 Dim intFF As Integer '파일 번호를 넣을 변수 Dim varResp() As Byte 'response값 넣을 배열 변수 Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP") 'XMLHTTP를 개체변수에 넣음 objXMLHTTP.Open "GET", strWeb, False '웹사이트 받기위해 소켓을 연다. '----------------------------------------------------------------------------- '주소가 잘못되거나 등의 이유로 에러 발생 시 처리할 코드 '----------------------------------------------------------------------------- On Error Resume Next '에러 발생할 경우 중단 않고 다음코드 진행 objXMLHTTP.Send '요청을 송신 If Err <> 0 Then Err.Clear '에러를 제거 ' msg = MsgBox(rngC.Address(0, 0) & " 의 주소가 잘못되었습니다." & _ ' "중단할까요?", vbYesNo, "에러 발생") ' If msg = vbYes Then 'Yes 선택 시 ' End '매크로 종료 ' Else 'No 선택 시 ' Exit Function '함수만 종료 ' End If End If '----------------------------------------------------- '요청이 완료될때 까지 대기하는 코드 '----------------------------------------------------- Do While objXMLHTTP.readyState <> 4 '요청이 준비상태 될때까지 기다림 DoEvents 'OS 에 제어권 돌려줌 Loop '무한 반복 varResp = objXMLHTTP.responseBody '배열에 결과 값을 돌려줌 '----------------------------------------------------------- '파일을 열고 컴퓨터에 파일을 저장하는 코드 '----------------------------------------------------------- intFF = FreeFile '(FreeFile은 Open에 의한 다음 파일번호를 정수형으로 return) If Dir(strCom) <> "" Then Kill strCom '동일한 파일이 이미 폴더에 존재 시 삭제 Open strCom For Binary As #intFF '바이너리 형식의 파일을 열기 Put #intFF, , varResp '파일을 폴더에 저장 Close #intFF '파일을 닫음 Set objXMLHTTP = Nothing '개체변수 초기화(메모리 비우기) End Function

VBA FILE DOWNLOAD 오류

0개의 답변

Q&A 목록