Created
July 26, 2018 11:12
-
-
Save mkysoft/4345649dc10d53ad64a226f1176485a1 to your computer and use it in GitHub Desktop.
Getting issues and label assignment date to Excel via VBA macro for time reporting
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Private pGitLabClient As WebClient | |
Private pToken As String | |
Private Property Get Token() As String | |
If pToken = "" Then | |
If Credentials.Loaded Then | |
pToken = Credentials.Values("GitLab")("token") | |
Else | |
pToken = InputBox("GitLab Token?") | |
End If | |
End If | |
Token = pToken | |
End Property | |
Private Property Get GitLabClient() As WebClient | |
If pGitLabClient Is Nothing Then | |
Set pGitLabClient = New WebClient | |
pGitLabClient.BaseUrl = "https://gitlab.com/api/v4" | |
Dim Auth As New TokenAuthenticator | |
Auth.Setup _ | |
Header:="PRIVATE-TOKEN", _ | |
value:=Token | |
Set pGitLabClient.Authenticator = Auth | |
End If | |
Set GitLabClient = pGitLabClient | |
End Property | |
Function GetSample() As String | |
'On Error GoTo ErrorHandler | |
Dim Request As New WebRequest | |
Dim Response As WebResponse | |
Request.Resource = "Invoice.svc/sample" | |
' Set the request format (Set {format} segment, content-types, and parse the response) | |
Request.Format = WebFormat.Json | |
' (GET, POST, PUT, DELETE, PATCH) | |
Request.Method = WebMethod.HttpGet | |
Set Response = GitLabClient.Execute(Request) | |
If Response.StatusCode <> WebStatusCode.Ok Then | |
Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu") | |
Else | |
GetSample = WebHelpers.ConvertToJson(Response.Data, " ", 2) | |
'MsgBox WebHelpers.ConvertToJson(Response.Data, " ", 2) | |
End If | |
'ErrorHandler: | |
' MsgBox "The following error occurred: " & Err.Description | |
End Function | |
Function GetIssiues(ProjectId As Long, Start As Integer) As Object | |
'On Error GoTo ErrorHandler | |
Dim Request As New WebRequest | |
Dim Response As WebResponse | |
Request.Resource = "/issues?project=" & ProjectId & "&page=" & Start & "&per_page=100" | |
' Set the request format (Set {format} segment, content-types, and parse the response) | |
Request.Format = WebFormat.Json | |
' (GET, POST, PUT, DELETE, PATCH) | |
Request.Method = WebMethod.HttpGet | |
Set Response = GitLabClient.Execute(Request) | |
If Response.StatusCode <> WebStatusCode.Ok Then | |
Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu") | |
Else | |
Set GetIssiues = Response.Data | |
'GetIssiues = WebHelpers.ConvertToJson(Response.Data, " ", 2) | |
'MsgBox WebHelpers.ConvertToJson(Response.Data, " ", 2) | |
End If | |
'ErrorHandler: | |
' MsgBox "The following error occurred: " & Err.Description | |
End Function | |
Function GetEvents() As Object | |
'On Error GoTo ErrorHandler | |
Dim Request As New WebRequest | |
Dim Response As WebResponse | |
Request.Resource = "/events?project=6452557&target_type=issue&action=closed&per_page=100" | |
' Set the request format (Set {format} segment, content-types, and parse the response) | |
Request.Format = WebFormat.Json | |
' (GET, POST, PUT, DELETE, PATCH) | |
Request.Method = WebMethod.HttpGet | |
Set Response = GitLabClient.Execute(Request) | |
If Response.StatusCode <> WebStatusCode.Ok Then | |
Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu") | |
Else | |
Set GetEvents = Response.Data | |
End If | |
End Function | |
Function GetNotes(ProjectId As Long, IssueId As Integer) As Object | |
'On Error GoTo ErrorHandler | |
Dim Request As New WebRequest | |
Dim Response As WebResponse | |
Request.Resource = "/projects/" & ProjectId & "/issues/" & IssueId & "/notes" | |
' Set the request format (Set {format} segment, content-types, and parse the response) | |
Request.Format = WebFormat.Json | |
' (GET, POST, PUT, DELETE, PATCH) | |
Request.Method = WebMethod.HttpGet | |
Set Response = GitLabClient.Execute(Request) | |
If Response.StatusCode = WebStatusCode.NotFound Then | |
'GetNotes = Null | |
ElseIf Response.StatusCode <> WebStatusCode.Ok Then | |
Button = MsgBox(Response.StatusDescription, vbAbortRetryIgnore + vbCritical, "Hata olustu") | |
Else | |
Set GetNotes = Response.Data | |
End If | |
End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Public Const Project_CoreGrid = 6452557 | |
Public Const Project_Jhipster = 6822181 | |
Public Const Project_Audit = 7277583 | |
Sub Button1_Click() | |
Dim PrevUpdating As Boolean | |
Dim LastIndex As Integer | |
PrevUpdating = Application.ScreenUpdating | |
Application.ScreenUpdating = False | |
LastIndex = 1 | |
GetIssues Project_CoreGrid, LastIndex | |
GetIssues Project_Jhipster, LastIndex | |
GetIssues Project_Audit, LastIndex | |
FindStartDates | |
'GetEvents | |
'ActiveSheet.Cells(5, 1) = "Yukleniyor | |
'ActiveSheet.Cells(5, 1) = gitlab.GetIssiues | |
Application.ScreenUpdating = PrevUpdating | |
End Sub | |
Sub GetIssues(ProjectId As Long, Optional ByRef LastIndex As Integer = 1, Optional LastPage As Integer = 1) | |
Dim Issues As Object | |
Dim Assignee As Object | |
Dim Sheet As Worksheet | |
Set Issues = gitlab.GetIssiues(ProjectId, LastPage) | |
Set Sheet = Worksheets("issues") | |
If (LastIndex = 1) Then | |
Sheet.UsedRange.Clear | |
Sheet.Cells(1, 1) = "project_id" | |
Sheet.Cells(1, 2) = "id" | |
Sheet.Cells(1, 3) = "iid" | |
Sheet.Cells(1, 4) = "title" | |
Sheet.Cells(1, 5) = "state" | |
Sheet.Cells(1, 6) = "assignee.name" | |
Sheet.Cells(1, 7) = "created_at" | |
Sheet.Cells(1, 8) = "closed_at" | |
LastIndex = LastIndex + 1 | |
End If | |
For Each Issue In Issues | |
Sheet.Cells(LastIndex, 1) = ProjectId | |
Sheet.Cells(LastIndex, 2) = Issue("id") | |
Sheet.Cells(LastIndex, 3) = Issue("iid") | |
Sheet.Cells(LastIndex, 4) = Issue("title") | |
Sheet.Cells(LastIndex, 5) = Issue("state") | |
If Not IsNull(Issue("assignee")) Then | |
Set Assignee = Issue("assignee") | |
Sheet.Cells(LastIndex, 6) = Assignee("name") | |
End If | |
Sheet.Cells(LastIndex, 7) = FormatDate(Issue("created_at")) | |
Sheet.Cells(LastIndex, 8) = FormatDate(Issue("closed_at")) | |
LastIndex = LastIndex + 1 | |
Next Issue | |
If LastIndex = LastPage * 100 + 2 Then | |
GetIssues ProjectId, LastIndex, LastPage + 1 | |
End If | |
End Sub | |
Sub FindStartDates() | |
Dim Notes As Object | |
Dim Assignee As Object | |
Dim Sheet As Worksheet | |
Dim ProjectId As Long | |
Dim IssueId As Integer | |
Set Sheet = Worksheets("issues") | |
Sheet.Cells(1, 9) = "started_at" | |
For Each Row In Sheet.Rows | |
'Bos satira gelince duralim | |
If IsEmpty(Sheet.Cells(Row.Row, 1).value) Then | |
Exit For | |
End If | |
'ilk satırı geçelim | |
If Row.Row > 1 Then | |
ProjectId = Sheet.Cells(Row.Row, 1).value | |
IssueId = Sheet.Cells(Row.Row, 3).value | |
Set Notes = gitlab.GetNotes(ProjectId, IssueId) | |
If Not Notes Is Nothing Then | |
For Each Note In Notes | |
If InStrRev(Note("body"), "added ~4112781 label", -1, vbTextCompare) > 0 Then | |
Sheet.Cells(Row.Row, 9) = FormatDate(Note("created_at")) | |
Exit For | |
End If | |
Next Note | |
End If | |
End If | |
Next Row | |
End Sub | |
Sub GetEvents() | |
Dim Events As Object | |
Dim Assignee As Object | |
Dim Sheet As Worksheet | |
Dim i As Integer | |
Set Events = gitlab.GetEvents | |
Set Sheet = Worksheets("events") | |
Sheet.UsedRange.Clear | |
Sheet.Cells(1, 1) = "issue_id" | |
Sheet.Cells(1, 2) = "action_name" | |
Sheet.Cells(1, 3) = "created_at" | |
i = 2 | |
For Each Evnt In Events | |
Sheet.Cells(i, 1) = Evnt("target_id") | |
Sheet.Cells(i, 2) = Evnt("action_name") | |
Sheet.Cells(i, 3) = Evnt("created_at") | |
i = i + 1 | |
Next Evnt | |
End Sub | |
Function FormatDate(value As Variant) As String | |
If IsNull(value) Or IsEmpty(value) Then | |
FormatDate = "" | |
Else | |
FormatDate = Mid(value, 9, 2) & "." & Mid(value, 6, 2) & ". " & Mid(value, 1, 4) & " " & Mid(value, 12, 8) | |
End If | |
End Function |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'' | |
' Http Token Authenticator v3.0.5 | |
' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web | |
' | |
' Custom IWebAuthenticator for GitLab Token Authenticator | |
' | |
' @class TokenAuthenticator | |
' @implements IWebAuthenticator v4.* | |
' @author mkysoft@gmail.com | |
' @license MIT (http://www.opensource.org/licenses/mit-license.php) | |
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' | |
Implements IWebAuthenticator | |
Option Explicit | |
' --------------------------------------------- ' | |
' Constants and Private Variables | |
' --------------------------------------------- ' | |
Private Const web_HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 | |
Private Const web_HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = 1 | |
' --------------------------------------------- ' | |
' Properties | |
' --------------------------------------------- ' | |
Public Header As String | |
Public value As String | |
' ============================================= ' | |
' Public Methods | |
' ============================================= ' | |
'' | |
' Setup | |
' | |
' @param {String} Header | |
' @param {String} Value | |
'' | |
Public Sub Setup(Header As String, value As String) | |
Me.Header = Header | |
Me.value = value | |
End Sub | |
'' | |
' Hook for taking action before a request is executed | |
' | |
' @param {WebClient} Client The client that is about to execute the request | |
' @param in|out {WebRequest} Request The request about to be executed | |
'' | |
Private Sub IWebAuthenticator_BeforeExecute(ByVal Client As WebClient, ByRef Request As WebRequest) | |
Request.SetHeader Me.Header, Me.value | |
End Sub | |
'' | |
' Hook for taking action after request has been executed | |
' | |
' @param {WebClient} Client The client that executed request | |
' @param {WebRequest} Request The request that was just executed | |
' @param in|out {WebResponse} Response to request | |
'' | |
Private Sub IWebAuthenticator_AfterExecute(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Response As WebResponse) | |
' e.g. Handle 401 Unauthorized or other issues | |
End Sub | |
'' | |
' Hook for updating http before send | |
' | |
' @param {WebClient} Client | |
' @param {WebRequest} Request | |
' @param in|out {WinHttpRequest} Http | |
'' | |
Private Sub IWebAuthenticator_PrepareHttp(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Http As Object) | |
'Http.SetCredentials Me.Username, Me.Password, web_HTTPREQUEST_SETCREDENTIALS_FOR_SERVER | |
End Sub | |
'' | |
' Hook for updating cURL before send | |
' | |
' @param {WebClient} Client | |
' @param {WebRequest} Request | |
' @param in|out {String} Curl | |
'' | |
Private Sub IWebAuthenticator_PrepareCurl(ByVal Client As WebClient, ByVal Request As WebRequest, ByRef Curl As String) | |
' e.g. Add flags to cURL | |
'Curl = Curl & " --basic --user " & WebHelpers.PrepareTextForShell(Me.Username) & ":" & WebHelpers.PrepareTextForShell(Me.Password) | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
You need VBA-Web for using this.