Option Explicit
Const ForReading = 1
Const TristateTrue = -1
Sub ImportCSVToKintone()
Dim FilePath As String
Dim CSVData As String
Dim CSVRows() As String
Dim CSVRow() As String
Dim i As Long
Dim Records As String
Dim KintoneURL As String
Dim KintoneAppID As String
Dim KintoneAPIToken As String
Dim objHTTP As Object
Dim FSO As Object, TS As Object
’ CSVファイルのパスを指定してください
FilePath = “C:\Users\yotar_irz3cuj\OneDrive\デスクトップ\津田 のコピー.csv”
’ KintoneのURL、アプリID、APIトークンを指定してください
KintoneURL = “https://eco-logistics.cybozu.com/k/v1/records.json”
KintoneAppID = “813”
KintoneAPIToken = “aaabubububububububu”
’ CSVファイルを読み込む (UTF-8 エンコーディング対応)
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Set TS = FSO.OpenTextFile(FilePath, ForReading, False, TristateTrue) ’ TristateTrue for UTF-8 encoding
CSVData = TS.ReadAll
TS.Close
’ CSVデータを行ごとに分割
CSVRows = Split(CSVData, vbCrLf)
’ ヘッダー行をスキップし、データ行をKintoneにインポート
For i = 1 To UBound(CSVRows) - 1
If Len(CSVRows(i)) > 0 Then
CSVRow = Split(CSVRows(i), “,”)
’ Kintoneのフィールドコードに合わせてデータを整形
Records = Records & “{”“納品日”“: {”“value”“: “”” & CSVRow(0) & “”“}, ““配送先番号””: {”“value”“: “”” & CSVRow(1) & “”“}, ““重量””: {”“value”“: “”” & CSVRow(2) & “”“}}”
If i < UBound(CSVRows) - 1 Then
Records = Records & “,”
End If
End If
Next i
’ Kintone REST APIを使ってデータをインポート
Set objHTTP = CreateObject(“MSXML2.ServerXMLHTTP”)
With objHTTP
.Open “POST”, KintoneURL, False
.setRequestHeader “Content-Type”, “application/json”
.setRequestHeader “X-Cybozu-API-Token”, KintoneAPIToken
.send “{”“app”“: “”” & KintoneAppID & “”“, ““records””: [” & Records & “]}”
End With
If objHTTP.Status = 200 Then
MsgBox “CSVデータのインポートが成功しました。”
Else
MsgBox “エラーが発生しました。” & vbCrLf & "ステータス: " & objHTTP.Status & vbCrLf & "レスポンス: " & objHTTP.responseText
End If
End Sub
このコードを実行したら、インポートが成功しました。と返ってくるのですが、
アプリにレコードが入ってません。
なぜだかわかる方教えていただけるとありがたいです。