Salesforce 자격 취득자 수의 PDF 파일을 다운로드하는 매크로

2927 단어 VBA

처음에



Salesforce와 관련이 있지만 VBA 만 내용입니다.

Salesforce 인증 자격 보유자 수 기업별 목록이 게시되었습니다. 자격마다 매월 파일을 하나하나 보고 있는 것만으로는 그다지 의미 있는 정보를 얻을 수 없을지도 모르지만, 정리해 보면 뭔가 보일지도 모릅니다.
이번에는 지정된 여러 파일을 지정된 폴더에 다운로드하는 Excel VBA입니다.

운영 환경



Windows 10의 Office365 (64bit) Excel에서 확인합니다. 이전 Office에서는 작동하지 않을 수 있습니다.



환경에 의존하는 일이나 VBA의 사용법 등 기본적인 내용은 스스로 해결해 주세요.

기능 - PDF 파일 다운로드



수식 - 이름 관리로 다운로드 폴더와 자격 목록의 위치가 정의되어 있으므로 확인하십시오.
자격 목록 시트의 B1 셀에 다운로드 대상 폴더 이름을 적어두고 "파일 다운로드"버튼을 클릭하면 파일이 다운로드됩니다. 끝나면 끝났을 때 메시지 상자에 표시됩니다.


매크로


Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
   (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long _
    ) As Long

Function DownloadPDFFile(url As String, path As String) As Boolean
    DownloadPDFFile = False
    Dim lRes As Long
    lRes = URLDownloadToFile(0, url, path, 0, 0)
    If lRes = 0 Then ' エラーなし
        DownloadPDFFile = True
    End If
End Function

Sub DownloadPDFFiles()
    Dim r As Range
    Dim strDLFolder As String

    strDLFolder = ThisWorkbook.Names("ダウンロードフォルダ").RefersToRange.Cells(1, 1).Value
    If strDLFolder = "" Then
        MsgBox "ダウンロード先フォルダ名が空なので終了します"
        Exit Sub
    End If
    If Dir(strDLFolder, vbDirectory) = "" Then
        MkDir strDLFolder
    End If

    Dim rangeExam As Range
    Set rangeExam = ThisWorkbook.Names("Salesforce認定資格").RefersToRange
    For Each r In rangeExam.Rows
        r.Cells(1, 6) = ""
    Next

    MsgBox strDLFolder & vbCrLf & "にファイルをダウンロードします", vbOKOnly

    For Each r In rangeExam.Rows
        Dim strFileName As String
        Dim strUrl As String
        '列番号は 1:略称 2:URL 3:ファイル名 4:分類 5:資格名 7:DL状況 8:取り込み
        strUrl = r.Cells(1, 2)
        strFileName = strDLFolder + "\" + Mid(strUrl, InStrRev(strUrl, "/") + 1)
        r.Cells(1, 6) = "*"
        If DownloadPDFFile(strUrl, strFileName) = False Then
            r.Cells(1, 6) = "失敗"
        Else
            r.Cells(1, 6) = "完"
        End If
        DoEvents
    Next
    MsgBox "取り込み完了しました", vbOKOnly
End Sub

파일



Bitbucket에 있습니다.
SF 자격 취득자 수.xlsm 다운로드

좋은 웹페이지 즐겨찾기