Desknet'sNEOからNiCollabo360へスケジュール移行する

Desknets NEOからNI Collaboへ、
利用者全員のスケジュールを移行が必要になったのでマクロを組んでみた。

#マクロファイル

zipファイルをダウンロード

##前提

• Desknets NEOからエクスポートするスケジュールは規定値で実施する。
• 登録作業は1ユーザずつ実施する。(NI Collaboの仕様上、一括削除、上書きができない為。)
• Step事にマクロ分割を行う。
• Ni Collaboのインポートは管理者画面から行う。(ユーザ画面からの実施は行わない。)

##移行内容

• 開始日
• 開始時刻
• 終了日
• 終了時刻
• 予定詳細
• 内容
• 情報公開レベル
• 終日予定

※以下の場合を終日予定とする。
　・開始日のみで開始時刻がない
　・開始時刻のみの入力
　・開始、終了時刻の入力の場合

##注意点
・仕様上、1度インポートしたスケジュールは、一括削除、変更が出来ないようなので登録時には注意。
・DesknetsExchange：動作時に負荷がかかる為、作業に時間がかかります。
・NIcoloboExport：スケジュールが2万件以以上の場合は以下範囲を変更して下さい。

NIcollaboExport変更箇所

 Rows("20002:100001").Select
 Selection.Clear

・インポート時：スケジュールが2万件以下の場合、エディタソフトで不要行削除推奨
　※インポート時に不要行の読み込み確認も行う為、時間がかかります。

##行程
① Desknets NEOからスケジュールをエクスポートする。
　 ※項目は規定で実施

② ①でエクスポートしたcsvをインポートする。

DesknetsImport

Sub DesknetsImport()

Dim csvfile1 As String
     

'デスクネッツのエクスポートデータをインポートする。
csvfile1 = Application.GetOpenFilename("csvファイル(*.csv),*.csv", 1, "1つ目のファイルを選択", False)
If csvfile1 = "False" Then Exit Sub
Workbooks.Open csvfile1

Sheets(1).Cells.Copy ThisWorkbook.Sheets(2).Range("A1")
ActiveWorkbook.Close False

Sheets(2).Name = "desknetsorg"

        MsgBox "氏名/組織名配下の姓名に半角スペースを入れて②を押して下さい"
End Sub

③ ②からデータコピーし、インポート用のデータへ返還する。

DesknetsExchange

'シート名desknetsorgを3シート目にコピーしていく

'①予定詳細⇒件名
  Sheets("desknetsorg").Select
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("B1").Select
    ActiveSheet.Paste

'②
  Sheets("desknetsorg").Select
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("P1").Select
    ActiveSheet.Paste

'②開始日⇒日付(開始)

  Sheets("desknetsorg").Select
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("C1").Select
    ActiveSheet.Paste

'③開始時刻⇒時間(開始)

  Sheets("desknetsorg").Select
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("D1").Select
    ActiveSheet.Paste

'④終了日付⇒日付(終了)
  Sheets("desknetsorg").Select
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("E1").Select
    ActiveSheet.Paste

'⑤終了時刻⇒時間(終了)
  Sheets("desknetsorg").Select
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("F1").Select
    ActiveSheet.Paste
    
 '⑥情報公開レベル⇒公開/非公開
   Sheets("desknetsorg").Select
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("J1").Select
    ActiveSheet.Paste

 '⑦情報公開レベル⇒公開/非公開
   Sheets("desknetsorg").Select
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("K1").Select
    ActiveSheet.Paste

 '⑧内容⇒内容
   Sheets("desknetsorg").Select
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(3).Select
    Range("L1").Select
    ActiveSheet.Paste
    
    
        Columns("F:F").Select
    Selection.Copy
    Columns("G:G").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False


       Range("H3").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC4="""",RC6=""""),""1"",IF(RC4=RC7,""1"",""""))"
    Range("H3").Select
Selection.AutoFill Destination:=Range("H3:H100001"), Type:=xlFillDefault

    
    Range("I3").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNTIFS(RC4:RC6,"">=0:00"",RC4:RC6,""<24:01"")"
     Range("I3").Select
Selection.AutoFill Destination:=Range("I3:I100001"), Type:=xlFillDefault
    
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "=IF(RC9=1,RC[-3],RC[-1])"
Selection.AutoFill Destination:=Range("G3:G100001"), Type:=xlFillDefault

    Range("G3").Select
    Selection.NumberFormatLocal = "[h]:mm"
    Selection.Copy
    Range("G4:G100000").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("G3").Select
    
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  
      Columns("G:G").Select
    Selection.Copy
    Columns("H:H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        

    Range("H3").Select
    Selection.NumberFormatLocal = "[h]:mm"
    Selection.Copy
    Range("H4:H100000").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

    Columns("H:H").Select
Cells.Replace What:=DateValue("00:00:00"), Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:I").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Columns("H:H").Select
Cells.Replace What:=DateValue("00:00:00"), Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
    
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K3").Select
        ActiveCell.FormulaR1C1 = "=IF(RC2="""",RC19,RC2)"
    Range("K3:K100001").Select
    Selection.FillDown

    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Columns("N:N").Select
    Selection.Replace What:="非", Replacement:="1", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Range("A1").Select
    ActiveCell.FormulaR1C1 = "分類(キーワード)"
    

Range("K1").Select
    ActiveCell.FormulaR1C1 = "件名"
    

    
Range("C1").Select
    ActiveCell.FormulaR1C1 = "(必須)日付 (開始)"
    
Range("D1").Select
    ActiveCell.FormulaR1C1 = "時間 (開始)"
    
Range("E1").Select
    ActiveCell.FormulaR1C1 = "(必須)日付 (終了)"

Range("H1").Select
    ActiveCell.FormulaR1C1 = "時間 (終了)"


Range("J1").Select
    ActiveCell.FormulaR1C1 = "終日"
    
Range("N1").Select
    ActiveCell.FormulaR1C1 = "閲覧制限"
    

Range("M1").Select
    ActiveCell.FormulaR1C1 = "場所"
    
Range("P1").Select
    ActiveCell.FormulaR1C1 = "内容"

    '行幅の調整

    Columns("A:K").EntireColumn.AutoFit
    
    Sheets(3).Name = "DesknetsExchange"
      Sheets("マクロシート").Select
    
        MsgBox "③を押してください"
        
    
End Sub

④ ③からデータコピーし、インポート可能な状態へ整列する。

NIcollaboExport

Sub NIcollaboExport()
Dim newFileName, newFileFolder, newFile As String

Sheets(3).Select

'①分類(キーワード)
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("A1").Select
    ActiveSheet.Paste

'②件名
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("B1").Select
    ActiveSheet.Paste
    
'③ (必須)社員

Range("C1").Select
    ActiveCell.FormulaR1C1 = "(必須)社員"

'④開始日
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("D1").Select
    ActiveSheet.Paste

'⑤開始時刻
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("E1").Select
    ActiveSheet.Paste

'⑥終了日程
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("F1").Select
    ActiveSheet.Paste


'⑦終了時刻
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("G1").Select
    ActiveSheet.Paste

'⑧終日
Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("H1").Select
    ActiveSheet.Paste
    
'⑨情報公開レベル

Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("I1").Select
    ActiveSheet.Paste
    
'③ 区分

Range("J1").Select
    ActiveCell.FormulaR1C1 = "区分"
    
'⑨場所

Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("O:O").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("K1").Select
    ActiveSheet.Paste


'⑨内容

Sheets(3).Select
  Sheets("DesknetsExchange").Select
    Columns("P:P").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(4).Select
    Range("L1").Select
    ActiveSheet.Paste


Sheets(4).Name = "NIcollaboExport"

Rows("2:2").Select
Selection.Delete Shift:=xlUp

    Sheets("desknetsorg").Select
    Range("B2").Select
    Selection.Copy
    Sheets("NIcollaboExport").Select
    Range("C2").Select
    ActiveSheet.Paste
    Range("C2:C100000").Select
    Application.CutCopyMode = False
    Selection.FillDown

    Rows("20002:100001").Select
    Selection.Clear

Range("A1").Select

'CSVエクスポート用

                
        Sheets("NIcollaboExport").Select
    Sheets("NIcollaboExport").Copy

       MsgBox "csvで保存してください"

End Sub

⑤ ④のデータをcsv形式で保存する。

⑥ ⑤のファイルで予定のない行を削除、上書きする。

⑦ 「④reset」ボタンを押下し
　　シートを削除、新しくシートを作成する

reset

Sub reset()

    Sheets(Array("desknetsorg", "DesknetsExchange", "NIcollaboExport")).Select
    Sheets("NIcollaboExport").Activate
    ActiveWindow.SelectedSheets.Delete
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add After:=Sheets(Sheets.Count)

End Sub

⑧ 保存したcsvをインポートする。