AI-Powered CV Sorter

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the prompts presented in the video.

CODE

'=========================================================
    ' PROJECT CONSTANTS
'=========================================================

' === USER SETTINGS ===
Private Const BASE_FOLDER As String = "C:\Youtube\Current\Archive\VBA_Masterclass\Course\LLM\CV_Sorter\"
Private Const TOP_N As Long = 2
Private Const GEMINI_API_URL As String = "https://generativelanguage.googleapis.com/v1beta/models/gemini-2.5-flash:generateContent?key="
' === FOLDER CONSTANTS ===
Private Const POTENTIAL_FOLDER As String = "Candidates\"
Private Const ACCEPTED_FOLDER As String = "Accepted\"
Private Const REJECTED_FOLDER As String = "Rejected\"
Private Const JOBDESC_FOLDER As String = "Job Description\"

'=========================================================
    ' MAIN SUB
'=========================================================
Public Sub RunCVScanner()
    ' Step 1: Load the Job Description
    Dim jobDesc As String
    jobDesc = LoadJobDescription()
    If Len(jobDesc) = 0 Then
        MsgBox "Job Description is empty or not found.", vbCritical
        Exit Sub
    End If
    'Debug.Print jobDesc
    ' Step 2: Load All CVs into Memory
    Dim CVs As Collection
    Set CVs = New Collection
    LoadCVs CVs
    
    ' Step 3: Evaluate CVs Using Gemini
    Dim cv As CVResult
    Dim evaluated As CVResult
    Dim i As Long
    For i = 1 To CVs.Count
        Set cv = CVs(i)
        Set evaluated = EvaluateCV(cv.cvText, cv.FileName, jobDesc)
        cv.score = evaluated.score
    Next i

    ' Step 4: Sort the CVs by Score
    SortCVResults CVs

    ' Step 5: Write Results to Excel
    WriteResultsToSheet CVs

    ' Step 6: Move Files Based on Ranking
    MoveCVsBasedOnRanking CVs
    
    ThisWorkbook.Worksheets("CV").Activate
End Sub

'=========================================================
    ' READ JOB DESCRIPTION
'=========================================================
Private Function LoadJobDescription() As String
    Dim f As String
    f = BASE_FOLDER & JOBDESC_FOLDER
    Dim FileName As String
    FileName = Dir(f & "*.docx")
    If Len(FileName) = 0 Then Exit Function
    LoadJobDescription = ReadWordDocument(f & FileName)
End Function
'=========================================================
    ' READ WORD DOCUMENT TEXT
'=========================================================
Private Function ReadWordDocument(filePath As String) As String
    Dim wdApp As Object, wdDoc As Object
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open(filePath, ReadOnly:=True)
    ReadWordDocument = wdDoc.Content.Text
    wdDoc.Close SaveChanges:=False
    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing
End Function

'=========================================================
    ' READ CVs
'=========================================================
Private Sub LoadCVs(ByRef CVs As Collection)
    Dim cvDir As String
    cvDir = BASE_FOLDER & POTENTIAL_FOLDER
    Dim file As String
    file = Dir(cvDir & "*.docx")
    Dim fullPath As String
    Dim cvText As String
    Dim r As CVResult
    Do While Len(file) > 0
        fullPath = cvDir & file
        cvText = ReadWordDocument(fullPath)
        Set r = New CVResult
        r.cvText = cvText
        r.FileName = fullPath
        r.score = 0
        CVs.Add r, file
        file = Dir()
    Loop
End Sub

'=========================================================
    ' EVALUATE CV USING GEMINI API
'=========================================================

Private Function EvaluateCV(cvText As String, cvPath As String, jobDesc As String) As CVResult
    Dim payload As String
    payload = BuildGeminiPayload(cvText, jobDesc)
    
    Dim response As String
    response = CallGeminiAPI(payload)
    
    Dim score As Double
    score = ParseScoreFromResponse(response)
    
    Dim r As New CVResult
    r.cvText = cvText
    r.FileName = cvPath
    r.score = score
    
    Set EvaluateCV = r
    
End Function

Private Function BuildGeminiPayload(cv As String, jd As String) As String
    BuildGeminiPayload = _
    "{""contents"":[{""parts"":[{""text"":""" & _
    "You are an HR Presonnel evaluating a candidate's skillset from a CV against a job description. " & _
    "Return ONLY a number between 0 and 100 representing how strong the match is. " & _
    "Higher number means better match." & vbCrLf & vbCrLf & _
    "Job Description:" & vbCrLf & jd & vbCrLf & vbCrLf & _
    "CV:" & vbCrLf & cv & _
    """}]}]}"
End Function

Private Function CallGeminiAPI(payload As String) As String
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    Dim URL As String
    URL = GEMINI_API_URL & GEMINI_API_KEY
    
    http.Open "POST", URL, False
    http.setRequestHeader "Content-Type", "application/json"
    http.send payload
    
    CallGeminiAPI = http.responseText
    'Debug.Print http.responseText
    
End Function

Private Function ParseScoreFromResponse(resp As String) As Double
    Dim json As Object
    Set json = JsonConverter.ParseJson(resp)
    Dim txt As String
    txt = json("candidates")(1)("content")("parts")(1)("text")
    ParseScoreFromResponse = Val(txt)
End Function


'=========================================================
    ' SORT RESULTS BY SCORE DESCENDING
'=========================================================

Private Sub SortCVResults(ByRef results As Collection)
    Dim arr() As CVResult
    Dim i As Long, j As Long
    Dim temp As CVResult
    'Match array size to collection
    ReDim arr(1 To results.Count)
    'Populate array with contents of the collection
    For i = 1 To results.Count
        Set arr(i) = results(i)
    Next i
    '(Bubble) sort the array - Highest score first
    For i = 1 To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(j).score > arr(i).score Then
                Set temp = arr(i)
                Set arr(i) = arr(j)
                Set arr(j) = temp
            End If
        Next j
    Next i
    'Erase the original collection
    Do While results.Count > 0
        results.Remove 1
    Loop
    'Repopulate the collection with the sorted contents of the array
    For i = 1 To UBound(arr)
        results.Add arr(i)
    Next i
End Sub
'=========================================================
    ' WRITE RESULTS
'=========================================================
Private Sub WriteResultsToSheet(ByVal results As Collection)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("CV")
    ws.Cells.ClearContents
    ws.Range("a1").Value = "FileName"
    ws.Range("B1").Value = "Score"
    Dim i As Long
    For i = 1 To results.Count
        ws.Cells(i + 1, 1) = Dir(results(i).FileName)
        ws.Cells(i + 1, 2) = results(i).score
    Next i
End Sub

'=========================================================
' MOVE ACCEPTED + REJECTED FILES
'=========================================================
Private Sub MoveCVsBasedOnRanking(ByVal results As Collection)
    Dim acceptedPath As String
    Dim rejectedPath As String
    acceptedPath = BASE_FOLDER & ACCEPTED_FOLDER
    rejectedPath = BASE_FOLDER & REJECTED_FOLDER
    If Dir(acceptedPath, vbDirectory) = "" Then MkDir acceptedPath
    If Dir(rejectedPath, vbDirectory) = "" Then MkDir rejectedPath
    Dim i As Long
    Dim sourceFile As String
    Dim dest As String
    For i = 1 To results.Count
        sourceFile = results(i).FileName
        If i <= TOP_N Then
            dest = acceptedPath & Dir(sourceFile)
        Else
            dest = rejectedPath & Dir(sourceFile)
        End If
        If Dir(dest) <> "" Then Kill dest
        Name sourceFile As dest
    Next i
End Sub