「所内公開」がルーム名についたリストをシート（チャットワークRoom）に書き出す（この時、ルームのメンバーリストも一緒に書き出しておく）

Excelから自動でChatWorkのグループチャットに追加するマクロ：ステップ１

Sub ルームID一覧()

    Dim myHttpRequest
    Dim myURL
    Dim myPostData
    Dim Result
    Dim roomList
    Dim elementList
    Dim roomID
    Dim roomName
    Dim i As Long
    
    myURL = "https://api.chatwork.com/v1/rooms"
    
    myPostData = "body=" &
    Set myHttpRequest = CreateObject("MSXML2.XMLHTTP.3.0")

    Call myHttpRequest.Open("GET", myURL, False)
    Call myHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
    Call myHttpRequest.setRequestHeader("X-ChatWorkToken", Token)
    Call myHttpRequest.send(myPostData)
    
    Result = myHttpRequest.responseText
    roomList = Split(Result, "{")
    
    Worksheets("チャットワークRoom").Range("A:C").Clear
    
    i = 1
    For Each elementList In roomList
        
        If InStr(elementList, "room_id") <> 0 Then
            
            elementList = Replace(elementList, """", "")
            roomID = Replace(Split(elementList, ",")(0), "room_id:", "")
            roomName = Replace(Split(elementList, ",")(1), "name:", "")
            roomName = ユニコードエスケープ文字復元(roomName)

            If 所内公開判定(roomName) Then
                Worksheets("チャットワークRoom").Cells(i, 1).Value = roomID
                Worksheets("チャットワークRoom").Cells(i, 2).Value = roomName
                Worksheets("チャットワークRoom").Cells(i, 3).Value = メンバーID一覧(roomID)
                i = i + 1
            End If
            
        End If
    Next elementList
    
    Set myHttpRequest = Nothing

End Sub

Function 所内公開判定(ルーム名)
    所内公開である = 0
        If InStr(ルーム名, "所内公開") <> 0 Then
            所内公開である = 1
        End If
  
    所内公開判定 = 所内公開である
    
End Function


Function ユニコードエスケープ文字復元(inputStr)
  Set re = CreateObject("VBScript.RegExp")
  re.Pattern = "\\u([a-fA-F0-9]{4})"
  re.Global = True
  re.IgnoreCase = True
  re.MultiLine = True

  Set mc = re.Execute(inputStr)
  For Each m In mc
    For Each s In m.submatches
      inputStr = Replace(inputStr, "\u" & s, ChrW("&h" & s))
    Next
  Next
  ユニコードエスケープ文字復元 = inputStr
End Function

Function メンバーID一覧(roomID)

    myURL = "https://api.chatwork.com/v1/rooms/" & roomID & "/members"

    Set myHttpRequest = CreateObject("MSXML2.XMLHTTP.3.0")

    Call myHttpRequest.Open("GET", myURL, False)
    Call myHttpRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
    Call myHttpRequest.setRequestHeader("X-ChatWorkToken", Token)
    Call myHttpRequest.send(myPostData)

    Result = myHttpRequest.responseText
    memberList = Split(Result, "{")
    i = 1
    adminID = ""
    memberID = ""
    For Each elementList In memberList
        If InStr(elementList, "account_id") <> 0 Then
            elementList = Replace(elementList, """", "")
            
            If InStr(Split(elementList, ",")(1), "role:admin") <> 0 Then
                If adminID = "" Then
                    adminID = "members_admin_ids=" & Replace(Split(elementList, ",")(0), "account_id:", "")
                Else
                    adminID = adminID & "," & Replace(Split(elementList, ",")(0), "account_id:", "")
                End If
            Else
                If memberID = "" Then
                    memberID = "members_member_ids=" & Replace(Split(elementList, ",")(0), "account_id:", "")
                Else
                    memberID = memberID & "," & Replace(Split(elementList, ",")(0), "account_id:", "")
                End If
            End If

        End If
    Next elementList
    
    メンバーID一覧 = adminID & "-" & memberID
    
    Set myHttpRequest = Nothing
    
End Function