VBA发送微信消息

dengni

lawrencespk 发表于 2018-2-21 23:00
请问楼主看得见吗?

您发微信的问题解决了吗？

资料更新中…

danielwotcha 发表于 2018-7-10 22:30
http://www.wotcha.net/?p=2572
已修正您代码中的错误，如上。能正常给企业微信通讯录人员发送消息。

这个获取的token是空的

danielwotcha

资料更新中… 发表于 2018-12-2 15:48
这个获取的token是空的

CorpID 和 Secret 有补上吗？

资料更新中…

有的,你q多少 我加你

dianadeng

留名，研究學習

10307951261

关注，学习一下

西行之鱼

先马再看。。。。。。

dengni

企业微信用户的数据库表一直在变更，前面的代码已经用不成了。下面的是重新写了代码，亲测使用正常。
功能是将微信用户数据写入自己的数据库
数据库表各字段名见蓝色字符

公众号请变更Url的连接

Sub GetWxUers()
'获取微信人员
Dim http
Dim MyArr, BtArr
Dim i1 As Integer, i2 As Integer, Str1 As String, Str2 As String, Str3 As String

Set http = CreateObject("MSXML2.ServerXMLHTTP")'token(CorpID, SecretStr0) token函数见一楼
Url = "https://qyapi.weixin.qq.com/cgi-bin/user/list?access_token=" & token(CorpID, SecretStr0) & "&department_id=1&fetch_child=1&status=0"
http.Open "Get", Url, False
http.send ""
If http.status = 200 Then
  Str1 = http.responseText
End If
'排除
Str1 = Replace(Str1, """", "")
sql = ""
MyArr = Split(Str1, "},{")
'表字段 自己数据库中表的字段要和企业微信中的字段相同
BtArr = Array("userid", "name", "department", "position", "mobile", "gender", "email", "avatar", "status", "enable", "isleader", "english_name", "hide_mobile", "telephone")
For i1 = 0 To UBound(BtArr)
    Str2 = Str2 & BtArr(i1) & ","
Next i1
Str2 = Left(Str2, Len(Str2) - 1)

For i = 0 To UBound(MyArr)
    For i1 = 0 To UBound(BtArr)
        Select Case BtArr(i1)
               Case "department"
                Str1 = Replace(Split(Split(MyArr(i), BtArr(i1) & ":")(1), "]")(0), "[", "")
               Case Else
                Str1 = Split(Split(MyArr(i), BtArr(i1) & ":")(1), ",")(0)
              End Select
              Str3 = Str3 & "'" & Str1 & "',"
     Next i1
     Str3 = Left(Str3, Len(Str3) - 1)
     sql = sql & " INSERT into [users] (" & Str2 & ") Values (" & Str3 & ");"
     Str3 = ""
Next i

Set ConnWy = Conn("SQL连接")ConnWy.Execute ("delete from [users] ")
ConnWy.Execute (sql)
ConnWy.Close

End Sub



Sub GetWxdepart()
'获取微信部门
Dim http
Dim MyArr, BtArr
Dim i1 As Integer, Str1 As String

Set http = CreateObject("MSXML2.ServerXMLHTTP")
'token(CorpID, SecretStr0) token函数见一楼
Url = "https://qyapi.weixin.qq.com/cgi-bin/department/list?access_token=" & token(CorpID, SecretStr0)
'
http.Open "Get", Url, False
http.send ""
If http.status = 200 Then
  Str1 = http.responseText
End If

'排除
Str1 = Replace(Str1, """", "")
sql = ""
MyArr = Split(Str1, "},{")
Str1 = ""
'表字段 自己数据表中设字段和企业微信中相同
BtArr = Array("id", "name", "parentid", "order")
For i = 0 To UBound(MyArr)
    For i1 = 0 To UBound(BtArr)
        Str1 = Str1 & "'" & Split(Split(MyArr(i), BtArr(i1) & ":")(1), ",")(0) & "',"
     Next i1
   
     Str1 = Left(Str1, Len(Str1) - 1)
     sql = sql & " INSERT into [departments] (id,name,parentid,[order]) " & " Values (" & Str1 & ");"   
     Str1 = ""
Next i

Set ConnWy = Conn("SQL连接")ConnWy.Execute ("delete from [departments] ")
ConnWy.Execute (sql)
ConnWy.Close

MsgBox "更新成功"

End Sub

bucengchulian

厉害学习一下

天国的猫猫

留名关注，好厉害，学习一下