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