Public Sub ファイル一覧取得()
Dim strPathName As String, vntPathName As Variant
Dim strFileName As String
Dim rtnString As String
Dim flgFirst As Boolean
flgFirst = True
rtnString = ""
' 先頭のファイル名の取得
strFileName = Dir(PathEditAdd(ActiveCell.Value), vbNormal) ' ③
' ファイルが見つからなくなるまで繰り返す
Do While strFileName <> "" ' ④
' 行を加算
If flgFirst = True Then
rtnString = strFileName
flgFirst = False
Else
rtnString = rtnString & vbCrLf & strFileName
End If
rtnString = rtnString & vbCrLf & strFileName ' ⑤
' 次のファイル名を取得
strFileName = Dir() ' ⑥
Loop
ClipBoadCopy rtnString
End Sub
Public Sub フォルダ一覧取得()
Dim fso As FileSystemObject
Set fso = New FileSystemObject ' インスタンス化
Dim rtnString As String
Dim pfl As Folder
Dim flgFirst As Boolean
rtnString = ""
Set pfl = fso.GetFolder(ActiveCell.Value) ' 親フォルダを取得
rtnString = ""
flgFirst = True
Dim fl As Folder
For Each fl In pfl.SubFolders ' サブフォルダの一覧を取得
If flgFirst = True Then
rtnString = fl.Name ' フォルダの名前 (TipsFolder) など
rtnString = rtnString & vbTab & fl.Path ' フォルダのパス (D:\TipsFolder) など
flgFirst = False
Else
rtnString = rtnString & vbCrLf & fl.Name ' フォルダの名前 (TipsFolder) など
rtnString = rtnString & vbTab & fl.Path ' フォルダのパス (D:\TipsFolder) など
End If
Next
ClipBoadCopy rtnString
' 後始末
Set fso = Nothing
End Sub
Public Sub 保持しているカーソル位置貼付()
Dim lngX As Long
Dim lngY As Long
lngX = CLng(GetSetting("MyTool", "Mouse", "X"))
lngY = CLng(GetSetting("MyTool", "Mouse", "Y"))
ActiveCell.Value = lngX
Cells(ActiveCell.Row, ActiveCell.Column + 1).Value = lngY
End Sub
Public Sub 作業自動化実行()
Dim strSql As String
Dim hwnd As Long
cnOpen (ExcelConnect)
strSql = "SELECT * FROM [AutoWork$]"
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenDynamic, adLockOptimistic, adCmdText
Do Until rs.EOF
Select Case rs("Action").Value
Case "Click"
SetCursorPos CLng(rs("X").Value), CLng(rs("Y").Value)
mouse_event 2 '左ボタン押下のコード
mouse_event 4 '左ボタン解放のコード
hwnd = 0
Do While hwnd = 0
hwnd = GetForegroundWindow
Loop
Case "Sleep"
Sleep CLng(rs("Param01").Value)
Case "SendMessage"
Call SndMsSetText(hwnd, rs("Param02").Value)
Case "SendKey"
SendKeys rs("Param02").Value
End Select
rs.MoveNext
Loop
cnClose
End Sub
Public Sub 保持しているウィンドウ貼り付け()
Dim Wnd As Long
Dim ret As Long
Wnd = CLng(GetSetting("MyTool", "Hundle", "Reg"))
BringWindowToTop (Wnd)
ret = shell("C:\Tool\ExeDll\clsDisplayCopy.exe", 1)
ShellEnd (ret)
BringWindowToTop (Application.hwnd)
ActiveCell.Select
ActiveSheet.Paste
End Sub
Public Sub WindowTopListGet()
SetRow = ActiveCell.Row
SetColumn = ActiveCell.Column
Call EnumWindows(AddressOf GetProc, 0)
End Sub
Public Sub Login_Security()
Dim parmhWnd As Long
Dim SearchhWnd As Long
Dim hWnd_User As Long
Dim hWnd_Password As Long
Dim hWnd_OK As Long
Dim ret As Integer
parmhWnd = FindWindow("#32770", "Windows セキュリティ")
parmhWnd = FindWindowEx(parmhWnd, 0, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
hWnd_OK = FindWindowEx(SearchhWnd, 0, vbNullString, vbNullString) 'OKボタン
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString) 'ユーザID
hWnd_User = FindWindowEx(SearchhWnd, 0, vbNullString, vbNullString)
SearchhWnd = FindWindowEx(parmhWnd, SearchhWnd, vbNullString, vbNullString) 'パスワード
hWnd_Password = FindWindowEx(SearchhWnd, 0, vbNullString, vbNullString)
ret = SndMsSetText(hWnd_User, "g01\fj2737gq")
'ret = SndMsSetText(hWnd_Password, "m6T$n5J?s6O?")
ret = SndMsClick(hWnd_OK)
End Sub
Public Sub 保持ウィンドウの非表示()
Dim strSql As String
cnOpen (ExcelConnect)
strSql = "SELECT * FROM [HundleSave$]"
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenDynamic, adLockOptimistic, adCmdText
Do Until rs.EOF
CloseWindow (CLng(rs("HundleID").Value))
rs.MoveNext
Loop
cnClose
End Sub
Public Sub 保持ウィンドウの表示()
Dim strSql As String
cnOpen (ExcelConnect)
strSql = "SELECT * FROM [HundleSave$]"
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenDynamic, adLockOptimistic, adCmdText
Do Until rs.EOF
OpenIcon (CLng(rs("HundleID").Value))
rs.MoveNext
Loop
cnClose
End Sub
Public Sub 保持ウィンドウのクリア()
MouseSaveClear
End Sub
Public Sub WindowRegSave()
SaveSetting "MyTool", "Hundle", "Reg", CStr(ActiveCell.Value)
End Sub
Public Sub WindowChildListGet()
Call ChildListSet
End Sub