ExcelVBAでエクスプローラ風のファイルコピー

ExcelVBA

例にアニメーション付きでコピーする

'C:\CopySource以下にあるファイルをすべてC:\CopyTarget\以下にコピーする。
'コピーに時間がかかる場合はコピー中のダイアログが自動的に表示される。

'このサンプルを動作させるにはフォーム上にコマンドボタンを１つ貼り付けること。

Private Declare Function SHFileOperation Lib "shell32" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4

Private Sub Command1_Click()

    Dim Ret As Long
    Dim sf As SHFILEOPSTRUCT

    sf.hwnd = Me.hwnd
    sf.wFunc = FO_COPY
    sf.pFrom = "C:\CopySource\*"
    sf.pTo = "C:\CopyTarget"

    Ret = SHFileOperation(sf)

    If Ret <> 0 Then MsgBox "失敗しました。"

End Sub

ネタ元

inno setupで excelが起動してたら止める

tool

issに以下記述

;excel起動してたら終了
[Code]
function IsAppRunning(const FileName: string): Boolean;
var
  FWMIService: Variant;
  FSWbemLocator: Variant;
  FWbemObjectSet: Variant;
begin
  Result := false;
  FSWbemLocator := CreateOleObject('WBEMScripting.SWBEMLocator');
  FWMIService := FSWbemLocator.ConnectServer('', 'root\CIMV2', '', '');
  FWbemObjectSet := FWMIService.ExecQuery(Format('SELECT Name FROM Win32_Process Where Name="%s"',[FileName]));
  Result := (FWbemObjectSet.Count > 0);
  FWbemObjectSet := Unassigned;
  FWMIService := Unassigned;
  FSWbemLocator := Unassigned;
end;

function InitializeSetup: boolean;
begin
  Result := not IsAppRunning('excel.exe');
  if not Result then
  MsgBox('excel.exe が起動しています。 Excelを終了させてから再度お試し下さい。', mbError, MB_OK);
end;

ネタ元

excelvbaでJST(日本時間)をミリ秒単位で取得

excelvba 
#If Win64 Then
Private Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
#Else
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
#End If

Private Function GetLocalTime() As String
    Dim t   As SYSTEMTIME
    Dim s
    
    ' 現在日時取得
    Call GetSystemTime(t)
    
    Dim JSTDateTime As Date
    JSTDateTime = CDate(Format(t.wYear, "0000") & "/" & Format(t.wMonth, "00") & "/" & Format(t.wDay, "00") _
                & " " & Format(t.wHour, "00") & ":" & Format(t.wMinute, "00") & ":" & Format(t.wSecond, "00"))
    JSTDateTime = JSTDateTime + TimeValue("9:00:00")
    
    GetLocalTime = Format(JSTDateTime, "yyyy/mm/dd hh:mm:ss")
    GetLocalTime = GetLocalTime + "." + Format(t.wMilliseconds, "000")
    
End Function

ネタ元