英文:
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
...
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论