'-----------------------------------------------------
' ファイルの所有者を取得する
' 引数 ：ファイルパス(File Only)
'-----------------------------------------------------
Private Function GetOwner(fpath As String) As String
Dim WMIService As Object
Dim objSet As Object
Dim obj As Object
Dim buf As String
'ちゃんと渡してよ！って抜ける
If Len(fpath) = 0 Then Exit Function
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
buf = ""
'TODO 本当はちゃんとエスケープしないとダメ
Set objSet = WMIService.ExecQuery("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" _
& Replace(fpath, "\", "\\") _
& "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")
For Each obj In objSet
buf = buf & obj.AccountName & ","
Next
If Len(buf) > 0 Then
GetOwner = Left(buf, Len(buf) - 1)
End If
Set obj = Nothing
Set objSet = Nothing
Set WMIService = Nothing
End Function
Private Function ExportFromXLSX(workbook_path as String,sheet_name as String, db_src as String, db_name as String,login_id as String, login_pw as String, table_name as String) As Boolean
Dim cn as ADODB.Connection
Dim recs_aff as Long
On Error Goto ErrFunc
Set cn = New ADODB.Connection
'2007バージョンのExcelファイルを開く
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & workbook_path & ";" & _
"Extended Properties=Excel 12.0"
'Jetプロバイダを使用してインポート
sql = "INSERT INTO [odbc;Driver={SQL Server};" & _
"Server=" & db_src & ";" _
& "Database=" & db_name & ";" _
& "UID=" & login_id _
& "PWD=" & login_pw _
& "]." & table_name _
& " SELECT * FROM [" & sheet_name & "$]"
cn.Execute sql, recs_aff, adExecuteNoRecords
cn.Close
Set cn = Nothing
ExportFromXLSX = True
Exit Function
ErrFunc:
'エラーメッセージ表示
' ---- (省略) ----
If Not cn Is Nothing Then
If cn.State=1 Then cn.Close
Set cn = Nothing
End If
End Function
With Worksheets(xx)
For c=1 to 100 Step 1
For r=1 to 100 Step 1
If Cstr(.Cells(r,c).Value) = CheckText Then
''' ここに処理 '''
End If
''' ここに下の結合セルのMax行数抽出のサンプル挿入 '''
Next r
Next c
End With
Dim rng As Range '確認対象セルを設定すること
If Not rng.MergeCells Then
'結合されていない場合
min_row = rng.Row
max_row = rng.Row
Else
'結合されている場合
min_row = rng.MergeArea.Cells(1, 1).Row
max_row = SearchMergeRowMin + rng.MergeArea.Rows.Count - 1
End If
