英文:
my excel becomes unresponsive while running a macro, it gets all the issues from JIRA using api using pagination
问题
Here's the translated code without the comments:
Sub Jira_for_all_issues_v6()
    Dim http As New MSXML2.XMLHTTP60, url As String, response As String, json As Object, startAt As Integer, batchSize As Integer, totalIssues As Integer, _
     issuesCount As Integer, has_subtsk As Boolean, print_row As Long, data As Object, ok_yes As Object, totalIssues5 As Integer, last_row_print As Long, _
     http1 As New MSXML2.XMLHTTP60, url1 As String, response1 As String, json1 As Object, user_name_password_in_base64_encoding As String, i As Integer
    Dim issues As Collection, StartTime As Double, SecondsElapsed As Double
    StartTime = Timer
    user_name_password_in_base64_encoding = UserPassBase64()
    Application.ScreenUpdating = False
    
    Worksheets("Sheet2").Cells(1, 1).Value = "Issue id"
    Worksheets("Sheet2").Cells(1, 2).Value = "Issue key"
    Worksheets("Sheet2").Cells(1, 3).Value = "Status"
    Worksheets("Sheet2").Cells(1, 4).Value = "Priority"
    Worksheets("Sheet2").Cells(1, 5).Value = "Reporter"
    Worksheets("Sheet2").Cells(1, 6).Value = "Reporter Id"
    Worksheets("Sheet2").Cells(1, 7).Value = "Creator"
    Worksheets("Sheet2").Cells(1, 8).Value = "Creator"
    
    url1 = "https://jira/rest/api/2/search?jql=project=project AND issuetype in (Bug)&maxResults=" & 1 & "&startAt=" & 0
    
    With http1
    .Open "GET", url1, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Accept", "application/json"
    .setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
    
    .send
    End With
    response1 = http1.responseText
    
    Set json1 = JsonConverter.ParseJson(response1)
    
    totalIssues = json1("total")
    
    startAt = 0
    batchSize = 100
    
    Set ok_yes = json1("issues")
    
    Do While startAt < totalIssues
        url = "https://jira-/rest/api/2/search?jql=project=project AND issuetype in (Bug)&maxResults=" & batchSize & "&startAt=" & startAt
        
        http.Open "GET", url, False
        
        http.setRequestHeader "Content-Type", "application/json"
        http.setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
        
        http.send
        response = http.responseText
        
        Set json = JsonConverter.ParseJson(response)
        
        issuesCount = json("issues").Count
        totalIssues5 = json("total")
        last_row_print = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        
        Set issues = json("issues")
        
        For i = 1 To issuesCount
            Worksheets("Sheet2").Cells(last_row_print, 1).Value = issues(i)("id")
            Worksheets("Sheet2").Cells(last_row_print, 2).Value = issues(i)("key")
            Worksheets("Sheet2").Cells(last_row_print, 3).Value = issues(i)("fields")("status")("name")
            Worksheets("Sheet2").Cells(last_row_print, 4).Value = issues(i)("fields")("priority")("name")
            Worksheets("Sheet2").Cells(last_row_print, 5).Value = issues(i)("fields")("reporter")("displayName")
            Worksheets("Sheet2").Cells(last_row_print, 6).Value = issues(i)("fields")("reporter")("name")
            Worksheets("Sheet2").Cells(last_row_print, 7).Value = issues(i)("fields")("creator")("name")
            Worksheets("Sheet2").Cells(last_row_print, 8).Value = issues(i)("fields")("creator")("displayName")
            
            last_row_print = last_row_print + 1
        Next i
        
        startAt = startAt + batchSize
    Loop
    SecondsElapsed = Round(Timer - StartTime, 2)
    
    MsgBox "All issues have been retrieved."
    
    Application.ScreenUpdating = True
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
To prevent Excel from becoming unresponsive, you can consider using background threading for the HTTP requests, so they don't block the main application. You can use multi-threading libraries available in VBA, like vbWatchdog or Async VBA, to achieve this. Additionally, you've already mentioned turning off Application.ScreenUpdating, which is a good practice to improve performance. Increasing the batch size can also help optimize the code further.
英文:
Sub Jira_for_all_issues_v6()
    Dim http As New MSXML2.XMLHTTP60, url As String, response As String, json As Object, startAt As Integer, batchSize As Integer, totalIssues As Integer, _
     issuesCount As Integer, has_subtsk As Boolean, print_row As Long, data As Object, ok_yes As Object, totalIssues5 As Integer, last_row_print As Long, _
     http1 As New MSXML2.XMLHTTP60, url1 As String, response1 As String, json1 As Object, user_name_password_in_base64_encoding As String, i As Integer
    Dim issues As Collection, StartTime As Double, SecondsElapsed As Double
StartTime = Timer
    user_name_password_in_base64_encoding = UserPassBase64()
    Application.ScreenUpdating = False
    
        Worksheets("Sheet2").Cells(1, 1).Value = "Issue id"
        Worksheets("Sheet2").Cells(1, 2).Value = "Issue key"
        Worksheets("Sheet2").Cells(1, 3).Value = "Status"
        Worksheets("Sheet2").Cells(1, 4).Value = "priority"
        Worksheets("Sheet2").Cells(1, 5).Value = "reporter"
        Worksheets("Sheet2").Cells(1, 6).Value = "reporter Id"
        Worksheets("Sheet2").Cells(1, 7).Value = "creator"
        Worksheets("Sheet2").Cells(1, 8).Value = "creator"
        
        url1 = "https://jira/rest/api/2/search?jql=project=project AND issuetype in (Bug)&maxResults=" & 1 & "&startAt=" & 0
    
    'Set the HTTP request properties
    With http1
    .Open "GET", url1, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Accept", "application/json"
    .setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
 
    
    'Send the HTTP request and retrieve the response
    .send
    End With
    response1 = http1.responseText
    
    'Parse the JSON data using a JSON parser library
    Set json1 = JsonConverter.ParseJson(response1)
    
    totalIssues = json1("total")
    
    startAt = 0
    batchSize = 100
'    print_row = 2
     Set ok_yes = json1("issues")
    
    Do While startAt < totalIssues
        'Set the URL to the JIRA REST API endpoint with the startAt and maxResults parameters
        url = "https://jira-/rest/api/2/search?jql=project=project AND issuetype in (Bug)&maxResults=" & batchSize & "&startAt=" & startAt
        
        'Set the HTTP request properties
        http.Open "GET", url, False
        
      
        http.setRequestHeader "Content-Type", "application/json"
        http.setRequestHeader "Authorization", "Basic " & user_name_password_in_base64_encoding
        'Send the HTTP request and retrieve the response
        http.send
        response = http.responseText
        
        'Parse the JSON data using a JSON parser library
        Set json = JsonConverter.ParseJson(response)
        
        'Extract the desired data from the parsed JSON data and insert it into your Excel worksheet
        
        issuesCount = json("issues").Count
        totalIssues5 = json("total")
        last_row_print = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        
        Set issues = json("issues")
        
        For i = 1 To issuesCount
            Worksheets("Sheet2").Cells(last_row_print, 1).Value = issues(i)("id")
            Worksheets("Sheet2").Cells(last_row_print, 2).Value = issues(i)("key")
            Worksheets("Sheet2").Cells(last_row_print, 3).Value = issues(i)("fields")("status")("name")
            Worksheets("Sheet2").Cells(last_row_print, 4).Value = issues(i)("fields")("priority")("name")
            Worksheets("Sheet2").Cells(last_row_print, 5).Value = issues(i)("fields")("reporter")("displayName")
            Worksheets("Sheet2").Cells(last_row_print, 6).Value = issues(i)("fields")("reporter")("name")
            Worksheets("Sheet2").Cells(last_row_print, 7).Value = issues(i)("fields")("creator")("name")
            Worksheets("Sheet2").Cells(last_row_print, 8).Value = issues(i)("fields")("creator")("displayName")
            
            last_row_print = last_row_print + 1
        Next i
        
        'Update the startAt parameter for the next batch of search results
        startAt = startAt + batchSize
    Loop
      SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "All issues have been retrieved."
    
    Application.ScreenUpdating = True
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
so this is my code. there are about 1000 issues in all and it takes about 16 mins to run. while this runs the excel app becomes unresponsive, how can prevent this and also any tips on how to optimize this code?
i tried turning off the appliction.screenupdating and it kinda works brought it down from 18 mins to 16 mins, also i had increased the batch size from 50 to 100.
答案1
得分: 1
在循环中适当加入 DoEvents,如下所示
...
    startAt = startAt + batchSize
    DoEvents
Loop
...
英文:
Squeeze in a DoEvents somewhere in the loop, like this
...
    startAt = startAt + batchSize
    DoEvents
Loop
...
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。


评论