Excel VBA スマレジタイムカードから出勤実績を取得する

スマレジタイムカードはiPadなどを利用して打刻して、WEBからその管理ができるサービスです。

有料版と無料版があり、無料版はシフト管理やCSVダウンロードといった機能がありません。

給与計算をする機能も付いているのですが、無料版では毎日出勤退勤時間を丸め、それに基づいて給与計算をしているようです。

ところがこれ、問題ありなんです。

労働基準監督署によると、切り捨てが許容されるのは1ヶ月トータルの実際の労働時間からせいぜい30分未満まで、ただし出勤時間については契約上の業務開始の時間に丸めるのはあり。もちろん通常の出勤の場合ですよ。会社から早出を指示していたり、早出をしないと追いつかないような業務実態があった場合は別です。

無料版スマレジタイムカードの機能では退勤時間を毎日丸めてしまい、かといってCSVダウンロードして一括処理もできず...
しょうがないから担当者の人は履歴を見て、手打ちで一人づつ、毎日の出退勤と休憩をエクセルに打ち直して計算...ヤッテラレルカーﾉ-_-)ﾉ ⌒┻┻
と相談がありましたのでいっちょ作ってみました。

CSVダウンロードはできないのでIEを操作することになります。
まずは参照設定を有効にして...

目的としては、
1,スマレジにログインし
2,目的の月の実績一覧を開き
3,実績をエクセルに取り込み
4,各スタッフの時給と交通費を取得し
5,給与・交通費を計算して
6,一覧表として展開する
となります。

以下、コードです
ただし複数回使用するようなコードはサブルーチンに分けてありますのでそれについては後述します。

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub getTMC()  'IEの表示をテストする。

On Error GoTo ErrgetTMC

If MsgBox("スマレジにログインしている場合はログアウトしてください。", vbOKCancel) = vbCancel Then
Exit Sub
End If

'所定のユーザー名とパスワード
Const myUser As String = "hogehoge@hogehoge.net"    '←実際のIDとパスワードに
Const myPass As String = "passpasspass"                          '←変更してください

'計算用
Dim n As Long
Dim n2 As Long
Dim n3 As Long

'エラー検証用
Dim Line As Long

'月と年
Dim myYear As Integer
Dim myMonth As Byte

'IEの起動
Dim objTable As Object
Dim objIE As InternetExplorer '変数を定義します。

'保存用workbookと取得データ処理用の変数
Dim APL
Dim BookS As Workbook

Dim myEndRow As Long
Dim myEndCol As Long

Dim myRow1 As Long
Dim myCol1 As Long

Dim myAr
Dim myArN As Long
Dim myCandP

'UserForm1のハンドル
Dim myResultBook As String

'以下本文

UserForm1.Show vbModeless

Application.ScreenUpdating = False

UserForm1.Label1.Caption = "InternetExplorerを呼び出しています。"

Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
objIE.Visible = False      '可視、Trueで見えるようにします。

Sleep 100

'処理したいページを表示します。
UserForm1.Label1.Caption = "スマレジタイムカードを読み込み中です。"
objIE.Navigate "https://accounts.smaregi.jp/login?client_id=timecard"  '.Navigate メソッドで表示する。

'ページの表示完了を待ちます。
Call WaitIEComp(objIE)

'IDとパスワードの入力&サインイン
If objIE.LocationURL = "https://accounts.smaregi.jp/login?client_id=timecard" Then
UserForm1.Label1.Caption = "スマレジタイムカードにログイン中です。"
objIE.Document.GetElementsByName("identifier").Item(0).Value = myUser
objIE.Document.GetElementsByName("password").Item(1).Value = myPass
objIE.Document.GetElementsByName("doLogin").Item(0).Click
Call WaitIEComp(objIE)

End If

UserForm1.Hide

'年と月を指定して読み込む
myYear = Application.InputBox("データを取得する年を半角整数で入力してください。", , Year(Date), , , , , 1)
myMonth = Application.InputBox("データを取得する月を半角整数で入力してください。 " & vbCrLf & Str(myYear) & "年", ,

Month(Date) - 1, , , , , 1)

UserForm1.Show vbModeless
UserForm1.Label1.Caption = "指定された月の実績を読み込み中です。"
objIE.Navigate ("https://timecard1.smaregi.jp/shifts/result/" & Application.WorksheetFunction.Text(myYear, "0000") &

"-" & _
Application.WorksheetFunction.Text(myMonth, "00"))

Call WaitIEComp(objIE)
objIE.Visible = True
Sleep 1000

'テーブルオブジェクト取り込み

Set objTable = objIE.Document.all.tags("TABLE")

Sleep 200

If objTable.Length = 0 Then
MsgBox "シフト表が見つかりません。"
GoTo ExitgetTMC
End If

'取り込みする表の確認
n = 2

Sleep 200

UserForm1.Hide
objIE.Visible = False

Do

If MsgBox("取り込みする表の確認" & vbCrLf & objTable(n).Summary, vbYesNo) = vbYes Then

myResultBook = objTable(n).Summary & ".xlsx"

Set APL = CreateObject("Excel.Application")
Set BookS = APL.Workbooks.Add

UserForm1.Show vbModeless
UserForm1.Label1.Caption = objTable(n).Summary & "を取り込んでいます。"

With BookS.Worksheets(1)
'表データの取り込み
For n2 = 0 To objTable(n).Rows.Length - 1
For n3 = 0 To objTable(n).Rows(n2).Cells.Length - 1
.Cells(n2 + 1, n3 + 1).Value = objTable(n).Rows(n2).Cells(n3).innertext
Next
Next
End With

Exit Do
Else
n = n + 1
End If

Sleep 200
Loop Until GetTableSummary(objTable, n) = ""

If UserForm1.Visible = False Then UserForm1.Show vbModeless

'時給と交通費データの取得開始
myCandP = GetCarfareAndPayment(objIE)

'所得したデータの処理

UserForm1.Label1.Caption = "取り込んだデータの処理中です。"

With BookS
.Worksheets(1).Copy after:=.Worksheets(1)
.Worksheets(1).Name = "計算前"
.Worksheets(2).Name = "計算後"

With .Worksheets("計算後")

'元範囲を確定
myEndRow = .Columns(1).Find("出勤人数", , , , xlWhole).Row - 1
myEndCol = .Rows(1).Find("計", , , , xlWhole).Column - 1
'出勤/退勤/休憩/時間の表に直す
For myArN = 2 To myEndRow
myRow1 = (myArN - 2) * 4 + 2
.Rows(myRow1 + 1).Insert xlShiftDown
.Rows(myRow1 + 2).Insert xlShiftDown
.Rows(myRow1 + 3).Insert xlShiftDown
.Cells(myRow1 + 3, 1).Value = .Cells(myRow1, 1).Value & " 時間(分)"
.Cells(myRow1 + 2, 1).Value = .Cells(myRow1, 1).Value & " 休憩(時間)"
.Cells(myRow1 + 1, 1).Value = .Cells(myRow1, 1).Value & " 退勤"
.Cells(myRow1, 1).Value = .Cells(myRow1, 1).Value & " 出勤"
myEndRow = myEndRow + 3
Next

'処理範囲再確定
myEndRow = .Columns(1).Find("出勤人数", , , , xlWhole).Row - 4

'出勤退勤休憩労働時各コマを計算
For myRow1 = 2 To myEndRow Step 4
For myCol1 = 2 To myEndCol
If .Cells(myRow1, myCol1).Value Like "出勤中" Then
.Cells(myRow1, myCol1).Value = ""
ElseIf Trim(.Cells(myRow1, myCol1).Value) <> "" Then

myAr = Split(Trim(.Cells(myRow1, myCol1).Text), " ")

For myArN = LBound(myAr) To UBound(myAr)
myAr(myArN) = TimeValue(myAr(myArN))
Next myArN

.Cells(myRow1, myCol1).Value = myAr(2)  '出勤は丸めた時間
.Cells(myRow1 + 1, myCol1).Value = myAr(1) '退勤は実際の時間

If DateDiff("h", myAr(2), myAr(1)) >= 6 Then '6時間以上実労なら1時間休憩
.Cells(myRow1 + 2, myCol1).Value = 1
Else
.Cells(myRow1 + 2, myCol1).Value = 0
End If

.Cells(myRow1 + 3, myCol1).Value = DateDiff("n", myAr(2), myAr(1)) _
- (.Cells(myRow1 + 2, myCol1).Value * 60) '実労時間計算

Else
.Cells(myRow1, myCol1).Value = ""
End If
Next myCol1
Next myRow1

'実労時間の集計
For myRow1 = 2 To myEndRow Step 4
myArN = Application.WorksheetFunction.Sum(.Range(.Cells(myRow1 + 3, 2), .Cells(myRow1 + 3, myEndCol)))
.Cells(myRow1 + 1, myEndCol + 1).Value = Str(Application.WorksheetFunction.Floor(myArN / 60, 1)) & ":" _
& Format((Application.WorksheetFunction.Floor(myArN Mod 60, 30)),

"0#")
.Cells(myRow1, myEndCol + 1).Value = myArN

'時給と交通費の検索
For n = 1 To UBound(myCandP, 2)
If Trim(Replace(.Cells(myRow1, 1).Value, "出勤", "")) = myCandP(0, n) Then
'時給
.Cells(myRow1 + 2, myEndCol + 1).Value = GetPaymentPer(.Cells(myRow1 + 1, myEndCol + 1).Value,

myCandP(2, n))
.Cells(myRow1 + 2, myEndCol + 2).Value = "'(＠" & CStr(myCandP(2, n)) & ")"
'交通費
.Cells(myRow1 + 3, myEndCol + 1).Value = Application.WorksheetFunction.Count( _
.Range(.Cells(myRow1 + 2, 2), .Cells(myRow1 + 2, myEndCol))) * CLng(myCandP(3, n))
.Cells(myRow1 + 3, myEndCol + 2).Value = "'(＠" & CStr(myCandP(3, n)) & ")"

Exit For
End If
Next n

.Range(.Cells(myRow1 + 3, 1), .Cells(myRow1 + 3, myEndCol + 1)).Borders(xlEdgeBottom).LineStyle =

xlContinuous
Next myRow1

End With

End With
ExitgetTMC:

'終了前にログアウト
UserForm1.Label1.Caption = "スマレジタイムカードからログアウトしています。"

If Not objIE Is Nothing Then objIE.Navigate ("https://accounts.smaregi.jp/logout")
If Not BookS Is Nothing Then
BookS.Close savechanges:=True, Filename:=ThisWorkbook.Path & "\" & myResultBook
MsgBox ThisWorkbook.Path & "\" & myResultBook & vbCrLf & "に結果を保存しました。"
End If

Application.ScreenUpdating = True
Unload UserForm1
objIE.Quit  '.Quitで閉じる

Set BookS = Nothing
Set objTable = Nothing
Set objIE = Nothing
Set APL = Nothing
ThisWorkbook.Close savechanges:=False

Exit Sub

ErrgetTMC:

MsgBox Err.Number & vbCrLf & Err.Description
GoTo ExitgetTMC
End Sub

↑↑↑↑↑↑↑ここまで
以下はサブルーチンです。

まずはIEを操作するので表示待ちは必須ですね。

Sub WaitIEComp(ByRef objIE As InternetExplorer)

'ページの表示完了を待ちます。
While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
DoEvents
Wend
End Sub

 

テーブルの名前を取得する部分です。何度も使いまわすわけではないのですが、表の取得に失敗した時のエラー処理をしやすくするためサブルーチン化しています。

Private Function GetTableSummary(objTable As Object, TableNum As Long) As String

On Error GoTo ErrGTS

Sleep 300
GetTableSummary = objTable(TableNum).Summary

Exit Function

ErrGTS:

GetTableSummary = ""
Err.Clear

End Function

 

各スタッフの時給と交通費を取得する部分です。

Function GetCarfareAndPayment(ByRef objIE As InternetExplorer) As Variant

Dim n As Long
Dim n2 As Long
Dim n3 As Long

n = 0
n2 = 1 '各個人名のセルは1列目で固定

Dim myTable As Object
Dim myAddress As String
Dim myResult As Variant
ReDim myResult(3, 1) '0名前1アドレス

UserForm1.Label1.Caption = "スタッフの一覧を取得しています。"

objIE.Navigate "https://timecard1.smaregi.jp/staffs/"
Call WaitIEComp(objIE)

Set myTable = objIE.Document.all.tags("TABLE")

'指定されたスタッフの情報ページアドレスを取得
Do
If GetTableSummary(myTable, n) = "基本情報" Then
For n3 = 1 To myTable(n).Rows.Length - 1 '行数分ループ
If n3 > 1 Then ReDim Preserve myResult(3, UBound(myResult, 2) + 1)

myAddress = myTable(n).Rows(n3).Cells(2).outerHTML
myAddress = Right(myAddress, Len(myAddress) - 27)
myAddress = Left(myAddress, Len(myAddress) - 9)

myResult(0, UBound(myResult, 2)) = Right(myAddress, Len(myAddress) - InStr(1, myAddress, ">"))
myResult(1, UBound(myResult, 2)) = Left(myAddress, InStr(1, myAddress, ">") - 2)
Next
End If

n = n + 1
Loop Until GetTableSummary(myTable, n) = ""

'取得したページに飛んで時給と交通費を取得
n = 0

For n = 1 To UBound(myResult, 2)

UserForm1.Label1.Caption = myResult(0, n) & "さんの時給と交通費を取得しています。"

objIE.Navigate "https://timecard1.smaregi.jp/" & myResult(1, n)
Call WaitIEComp(objIE)
Set myTable = Nothing
Set myTable = objIE.Document.all.tags("TABLE")

n2 = myTable.Length - 1

Do
If GetTableSummary(myTable, n2) = "基本情報" Then
myResult(2, n) = GetCurrencyFromCell(myTable(n2).Rows(5).Cells(1).innerHTML)
myResult(3, n) = GetCurrencyFromCell(myTable(n2).Rows(6).Cells(1).innerHTML)
Exit Do
End If

n2 = n2 - 1
Loop Until n2 = 0
Next n

Set myTable = Nothing

GetCarfareAndPayment = myResult
End Function

 

↑で取得できる表の中では時給や交通費に「円」がついています。そのままでは計算に使えないので余分な部分を切り取ります。

Private Function GetCurrencyFromCell(ByVal SourceData As String) As String

Do
SourceData = Left(SourceData, Len(SourceData) - 1)

If IsNumeric(SourceData) = True Then
GetCurrencyFromCell = SourceData
Exit Do
ElseIf Len(SourceData) = 1 Then
GetCurrencyFromCell = "0"
Exit Do
End If

Loop
End Function

 

親ルーチン内で労働時間は1分単位で合計したあと、30分単位に丸めて"00:00"という形式で表示しています。
これを給与計算するために時間単位に直します。ここは回りくどくなってしまいました。
Private Function GetPaymentPer(ByVal Times As String, ByVal Payment As String) As Long

Dim myMinute As String
Dim myPay As Long

myMinute = Right(Times, 3)

myPay = CLng(Payment) * CLng(Replace(Times, myMinute, ""))
If myMinute = ":30" Then
myPay = myPay + Payment * 0.5
End If

GetPaymentPer = myPay

End Function

↑↑↑ここまで
Webのコーディングは以前より複雑化してオブジェクトをとらえるのもなかなか面倒になってきていますが、
Chromeのデベロッパーツールは便利です。

無事、データの取得には成功しましたが、1つ問題点が残ります。
スマレジの表ですが、おそらく読み込みの高速化と負荷分散を目的としていると思うのですが、画面上で表示範囲に入った時に初めて表が描画されます。表一覧を取得する前にいったんobjIE.visible=Trueして表示しているのはそのためです。これが複数の表を表示すると下の方がスクロールしてからでないと描画されないのでエラーが発生してしまいます。店舗が一つなら行けるんですけどね。
いろんなWebページで同様の技術が取り入れられているようなので、データ取得の難しいページが増えていくかもしれません。