CODEWITHSUNDEEP
vbaexcel
Gregory
Gregory

Reputation: 315

Best way to check file extensions in a string?

I have a report where one cell in each row contains the name (w/extension) of every file connected to a particular account. There are a few combinations that we look for, with the rest being consiered invalid and requiring that we email the account holder. I'm currently just checking if the filetypes exist through If Then statements with the Like operator (eg. If cells(i,11).value2 like ".xls" Then), or, if there is more than 1, a function that checks the number of times a particular file extension appears.

Currently I'm able to parse through and find specific filetypes, but I can't tell definitively what a specific filetype is related to unless I check the correct combinations against it, which requires a whole bunch of conditions that I'm betting can be added to a list or something and checked against. If it helps at all, there are different values than "Contacts" that require different combinations to check against.

Please see a sample of my current code below:

If (cells(i,10).value2 = "Contacts" Then 'Checking if one exists

   If (cells(i,11).value2 Like "*.pdf*" or cells(i,11).value2 Like "*.mht*") and (not cells(i,11).value2 like "*.msg*" or not cells(i,11).value2 like "*.oft*") Then
       cells(i,12).value2 = "Incorrect email uploaded"

   ElseIf (cells(i,11).value2 Like "*.zip*" or cells(i,11).value2 Like "*.rar*") and (not cells(i,11).value2 like "*.msg*" or not cells(i,11).value2 like "*.oft*") and (cells(i,11).value2 like "*.xls*" or cells(i,11).value2 like "*.doc*" Then
       cells(i,12).value2 = "Probably missing email"

   ElseIf (not cells(i,11).value2 Like "*.msg*" and not cells(i,11).value2 Like "*.oft*") and cells(i,11).value2 like "*.doc*" Then
        cells(i,12).value2 = "Missing email"

   ElseIf (cells(i,11).value2 Like "*.msg*" or cells(i,11).value2 Like "*.oft*") and not cells(i,11).value2 like "*.doc*" Then
        cells(i,12).value2 = "Missing contacts document"

   End If
End If

 If (cells(i,10).value2 = "Contacts" Then 'Checking if two exist

   If StrOcc(cells(i,11).value2, ".msg") < 2 or StrOcc(cells(i,11).value2, ".oft") < 2 Then
       cells(i,12).value2 = "Missing 1 email uploaded"

   End If
 End If

Function StrOcc(text as String, checkedagainst as substring)
  if instr(...

Upvotes: 0

Views: 167

Answers (1)

paul bica
paul bica

Reputation: 10715

This might make it easier to work with:

If Cells(i, 10).Value2 = "Contacts" Then 'Checking if one exists

    Dim str As String, email1 As Long, email2 As Long
    Dim pdf_mht As Boolean, zip_rar As Boolean, doc As Boolean, xls_doc As Boolean

    str = Cells(i, 11).Value2

    email1 = UBound(Split(str, ".msg"))
    email2 = UBound(Split(str, ".oft"))

    pdf_mht = UBound(Split(str, ".pdf")) > 0 And UBound(Split(str, ".mht")) > 0
    zip_rar = UBound(Split(str, ".zip")) > 0 And UBound(Split(str, ".rar")) > 0

    doc = UBound(Split(str, ".doc")) > 0
    xls_doc = UBound(Split(str, ".xls")) > 0 And doc

    If email1 = 0 And email2 = 0 Then
        Cells(i, 12).Value2 = "Missing email"
    ElseIf email1 = 0 Or email2 = 0 Then
        If pdf_mht Then
            Cells(i, 12).Value2 = "Incorrect email uploaded"
        ElseIf zip_rar And xls_doc Then
            Cells(i, 12).Value2 = "Probably missing email"
        ElseIf doc Then
            Cells(i, 12).Value2 = "Missing contacts document"
        End If
    ElseIf email1 < 2 Or email2 < 2 Then
        Cells(i, 12).Value2 = "Missing 1 email uploaded"
    End If
End If

(untested)

Upvotes: 1

Related Questions