VBA

Private Sub CommandButton1_Click()
    Dim Invoice, Reference
    Invoice = Worksheets("Sheet1").Range("H1:H300")
    'MsgBox (VarType(Invoice))
    'MsgBox (Invoice)
    'Invoice = Range("H1").Value
    Reference = Application.WorksheetFunction.VLookup(Invoice, Worksheets("Sheet2").Range("A1:B300"), 2, False)
    Dim i As Integer
    i = 1
    For Each Item In Reference
        Worksheets("Sheet3").Cells(i, 1) = Item
        i = i + 1
    Next Item
    MsgBox ("Done")
    'MsgBox (VarType(Reference))
   

End Sub

Private Sub CommandButton2_Click()
    'Name "C:\VBA Folder\Sample file 1.xlsx" As "C:\VBA Folder\Sample file 2.xlsx"
End Sub

Private Sub CommandButton3_Click()
    Dim FSO As Object '//FileSystemObject
    Dim f As Object '//File Object
    Dim i As Integer
    Dim temp As String
    i = 1
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO
        If .FolderExists(TextBox1.Text) Then
            For Each f In .GetFolder(TextBox1.Text).Files
                temp = fnClean(f.Name)
               
                Worksheets("Sheet5").Cells(i, 2) = temp
                i = i + 1
                'Debug.Print f.Path
            Next f
        End If
    End With
End Sub
Function fnClean(temp As String) As String
    Dim NewTemp As String
    Dim blnMatch As Boolean
    blnMatch2 = True
    NewTemp = temp
    While blnMatch2 = True
        blnMatch = False
        If LCase(Right(NewTemp, 4)) = ".tif" Then
            NewTemp = Left(NewTemp, (Len(NewTemp) - 4))
            blnMatch = True
        End If
        If LCase(Right(NewTemp, 4)) = ".png" Then
            NewTemp = Left(NewTemp, (Len(NewTemp) - 4))
            blnMatch = True
        End If
        If LCase(Right(NewTemp, 5)) = ".temp" Then
            NewTemp = Left(NewTemp, (Len(NewTemp) - 5))
            blnMatch = True
        End If
        If LCase(Right(NewTemp, 4)) = ".pdf" Then
            NewTemp = Left(NewTemp, (Len(NewTemp) - 4))
            blnMatch = True
        End If
        If Right(NewTemp, 1) = "." Then
            NewTemp = Left(NewTemp, (Len(NewTemp) - 1))
            blnMatch = True
        End If
        If blnMatch = False Then
            blnMatch2 = False
        End If
        For x = 0 To 9
            If LCase(Right(NewTemp, 6)) = ".pdf-" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 6))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-0" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-1" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-2" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-3" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-4" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x
        For x = 0 To 9
            If LCase(Right(NewTemp, 7)) = ".pdf-5" & x Then
                NewTemp = Left(NewTemp, (Len(NewTemp) - 7))
                blnMatch = True
            End If
        Next x

    Wend

    fnClean = NewTemp
End Function

Function fnTest()
    'On Error GoTo Oops
    'Dim i As Integer
    'i = 1
    'StrFile = Dir(TextBox1.Text & "\*")
    'Dim temp As String
'Send:
    'Do While Len(StrFile) > 0
       
        'If temp <> Null Then
            'temp = Dir
            'Sheet3.Cells(i, 2) = temp
            'i = i + 1
        'End If
       

    'Loop
    'Exit Sub
'Oops:
    'handle error here
    'MsgBox (temp)
    'temp = "error"
    'Exit Sub
    'Resume Send
    'risk of endless loop if the new URL is also bad
   
   
   
    'Dim StrFile As String
   
    'Dim i As Integer
    'i = 1
    'StrFile = Dir(TextBox1.Text & "\*")
    'Do While Len(StrFile) > 0
        'Sheet3.Cells(i, 2) = Dir
        'i = i + 1
        'On Error Resume Next
        'If Err <> 0 Then
            'not 0 means it errored, handle it here
            'Err.Clear 'keep in mind this doesn't reset the error handler, any code after this will still ignore errors
        'End If

    'Loop
   
    'Dim MyObj As Object, MySource As Object, file As Variant
    'Set MySource = MyObj.GetFolder(TextBox1.Text & "\")
    'For Each file In MySource.Files
        'Sheet3.Cells(i, 2) = file
        'i = i + 1
        'If InStr(file.Name, "test") > 0 Then
            'MsgBox "found"
        'Exit Sub
        'End If
    'Next file

End Function

Private Sub CommandButton4_Click()
    Dim FSO As Object '//FileSystemObject
    Dim f As Object '//File Object
    Dim i As Integer
    Dim temp As String
    i = 1
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO
        If .FolderExists(TextBox1.Text) Then
            For Each f In .GetFolder(TextBox1.Text).Files
                'temp = fnClean(f.Name)
               
                Worksheets("Sheet4").Cells(i, 1) = TextBox1.Text + f.Name
                i = i + 1
                'Debug.Print f.Path
            Next f
        End If
    End With
End Sub

Private Sub CommandButton5_Click()

End Sub

Private Sub UserForm_Click()

End Sub