【Excel-VBA】フォルダ内のファイル一括削除

Sub フォルダ内のファイルの削除A()
Dim FName As String
Const Path As String = “C:\2020年度\”
FileName = Dir(Path & “*.xlsx”)
If FileName = “” Then
MsgBox “ファイルがありません。”
Else
Kill “C:\2020年度\*.xlsx”
MsgBox “ファイルを削除しました。”
End If
End Sub

【Excel-VBA】ファイル選択のダイアログボックスを操作するWindows

①API宣言
Declare PtrSafe Function FindWindow Lib “user32” Alias “FindWindowA” ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

‘ 編集部分を取得するため
Declare PtrSafe Function FindWindowEx Lib “user32” Alias “FindWindowExA” ( _
ByVal hwndParent As LongPtr, _
ByVal hwndChildAfter As LongPtr, _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

‘ 編集部分に文字列を送るため
Declare PtrSafe Function SendMessage Lib “user32” Alias “SendMessageA” ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As LongPtr

Sub sample()

‘ファイル選択ダイアログボックスのハンドルを捕まえる
Dim handle As Long
handle = FindWindow(“#32770”, “開く”)

‘捕まえたハンドル(handle)から入力ボックス(ファイル名が入るところ)のハンドルを捕まえる
Dim hInputBox As Long
hInputBox = FindWindowEx(handle, 0&, “ComboBoxEx32”, “”)
hInputBox = FindWindowEx(hInputBox, 0&, “ComboBox”, “”)
hInputBox = FindWindowEx(hInputBox, 0&, “Edit”, “”)
Call SendMessage(hInputBox, &HC, 0, ByVal “*ファイルPATH“)

‘捕まえたハンドル(handle)から”開く”ボタンのハンドルを取得する
Dim hButton As Long
hButton = FindWindowEx(handle, 0&, “Button”, “開く(&O)”) ‘開くボタン
Call SendMessage(hButton, &HF5, 0, 0&) ‘ボタンをクリックする

End Sub

こちらのブログから転記させて頂きました。とても助かりました

【Excel-VBA】タブ区切りテキストインポート カンマ区切りCSVインポート

Sub utf8import()
    Dim ws As Worksheet
    Dim qtbl As QueryTable
    Dim getfilepath As String
    
    Set ws = ActiveSheet
    
    getfilepath = Application.GetOpenFilename("ブック, *.txt") ' .txtファイルを選ぶ
    If getfilepath <> "False" Then
    Else
        MsgBox "キャンセル"
        End
    End If
    
    Set qtbl = ws.QueryTables.Add(Connection:="TEXT;" & getfilepath, Destination:=ws.Range("A1")) ' CSV を開く
    With qtbl
        .TextFilePlatform = 65001        ' 文字コード UTF-8
        .TextFileTabDelimiter = True     ' タブ区切り
        .RefreshStyle = xlOverwriteCells ' 上書き
        .Refresh                         ' 表示する
        .Delete                          ' CSV接続 解除
    End With

End Sub

UTF-8 LF改行の場合のタブ区切り

Sub Sample2()
Dim buf As String, Target As String, i As Long
Dim tmp1 As Variant, tmp2 As Variant, j As Long
Target = “C:\商品レポート.txt”
With CreateObject(“ADODB.Stream”)
.Charset = “UTF-8”
.Open
.LoadFromFile Target
buf = .ReadText
.Close
tmp1 = Split(buf, vbLf) ‘LFはvbLf CR + LFはvbCrLf
For i = 0 To UBound(tmp1)
tmp2 = Split(tmp1(i), vbTab) ‘タブはvbTab
j = j + 1
Range(Cells(j, 1), Cells(j, 34)) = tmp2
Next i
End With
End Sub

カンマ区切り

Sub utf8importcsv()
    Dim ws As Worksheet
    Dim qtbl As QueryTable
    Dim getfilepath As String
    
    Set ws = ActiveSheet
    
    getfilepath = Application.GetOpenFilename("ブック, *.csv") ' .csvファイルを選ぶ
    If getfilepath <> "False" Then
    Else
        MsgBox "キャンセル"
        End
    End If
    
    Set qtbl = ws.QueryTables.Add(Connection:="TEXT;" & getfilepath, Destination:=ws.Range("A1")) ' CSV を開く
    With qtbl
        .TextFilePlatform = 65001        ' 文字コード UTF-8
        .TextFileCommaDelimiter = True   ' カンマ区切り
        .RefreshStyle = xlOverwriteCells ' 上書き
        .Refresh                         ' 表示する
        .Delete                          ' CSV接続 解除
    End With

End Sub

【Excel-VBA】離れた選択セルを順に処理Ctrl+クリックで選択したセル位置を取得

Sub try()
Dim r As Range
Dim rr As Range

Set rr = Range(“A1”)

For Each r In Selection
rr.Value = r.Value
Set rr = rr.Offset(1)
Next

Set rr = Nothing
End Sub

少し変更

For Each r In Selection ‘選択範囲を順に実行
k = r.Row

‘ Cells(i, 2).Value = r.Value
Cells(i, 2).Value = Cells(k, 2).Value
i = i + 1
Next

【Excel-VBA】Functionの引数 戻り値 

Function プロシージャ名(ByVal 引数名1 As データ型, ByVal 引数名2 As データ型, ・・・) As 戻り値のデータ型
プロシージャ名 = 戻り値
End Function

Sub macro3()
Dim str As String
str = func3(2, 3)
MsgBox str, vbInformation
End Sub

Function func3(ByVal num1 As Integer, ByVal num2 As Integer) As String
Dim mul As Integer
mul = num1 * num2
func3 = CStr(num1) & ” * ” & CStr(num2) & ” = ” & CStr(mul)
End Function

【VBA+Chromedriver】URLエンコード 64bit対応

Public Sub Sample()
MsgBox EncodeURL(“キーワード”)
End Sub

Private Function EncodeURL(ByVal sWord As String) As String
Dim d As Object
Dim elm As Object

sWord = Replace(sWord, “\”, “\”)
sWord = Replace(sWord, “‘”, “\'”)
Set d = CreateObject(“htmlfile”)
Set elm = d.createElement(“span”)
elm.setAttribute “id”, “result”
d.body.appendChild elm
d.parentWindow.execScript “document.getElementById(‘result’).innerText = encodeURIComponent(‘” & sWord & “‘);”, “JScript”
EncodeURL = elm.innerText

End Function

【VBA+Chromedriver】画像アドレス取得

For k = 2 To row01 ‘画像アドレス取得

chk = Cells(k, 4).Value ’画像を探すページアドレスの一覧

 driver.Get (chk)

Set elements = driver.FindElementsByTag("img") ’ページから imgタグのある要素一気に抜き出し

For i = 1 To elements.Count
'リンクURLを収集する
aLink = elements.Item(i).Attribute("src")

‘ atitl = elements.Item(i).Text

  If InStr(aLink, "https://m.media-amazon.com") <> 0 And InStr(aLink, "UL320") <> 0 Then ’抜き出された画像ドレスに色々条件つけて確定




    sh01.Cells(k, 5).Value = aLink


Exit For

  End If
Next i