+ Reply to Thread
Results 1 to 4 of 4

fixing code

  1. #1
    timmy64 - ExcelForums.com
    Guest

    fixing code

    Hi, I have this code that first chooses a folder, then it converts the
    files in the folder with the word "detail" in its name, then it saves
    them in a new folder it creates with the same name as its root folder
    but with a number at the end of it. It's been working up until now,
    but for some reason it gets an error now (see below)



    Sub ListFilesInFolder()

    Application.DisplayAlerts = False
    Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
    temp9, temp10, FILE_PATH As Variant
    Dim c As Integer
    Dim t1(20) As Variant
    Application.DisplayAlerts = False
    Dim path As Variant
    path = PickFolder("C:\") & "\"
    t = Dir(path & "*detail*.htm")
    Dim c1 As Integer

    While t <> ""
    t1(c1) = t
    t = Dir()
    c1 = c1 + 1
    Wend

    c = 0

    For I = 0 To 20
    If t1(I) = "" Then
    GoTo a:
    End If

    If c = 0 Then
    temp3 = path
    temp4 = Split(temp3, "\")
    temp5 = temp4(UBound(temp4) - 1)
    temp6 = lastest_folder(temp3, temp5) 'finds the latest folder that
    was created
    If temp6 <> "" Then
    temp10 = Split(temp6, temp5)
    temp7 = CInt(temp10(1))
    <-------------------------------------------------------- error:
    type mismatch
    End If

    If Err.Description <> "" Then
    temp8 = 1
    temp9 = Format(temp8, "000#")
    Else
    temp8 = temp7 + 1
    temp9 = Format(temp8, "000#")
    End If

    MkDir temp3 & temp5 & temp9
    c = 1
    End If

    Workbooks.OpenText path & t1(I)
    ActiveWorkbook.SaveAs Filename:= _
    ActiveWorkbook.path & "\" & temp5 & temp9 & "\" &
    ActiveWorkbook.Name & ".xls", _
    FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Next

    Application.DisplayAlerts = True

    fill_file_names

    a:

    End Sub

    Function lastest_folder(p As Variant, ar2 As Variant)

    Dim t1 As Variant
    t = Dir(p & ar2 & "*.*", vbDirectory)

    While t <> ""
    If (t <> "") Then
    t1 = t
    End If
    t = Dir()
    Wend

    If t1 = "" Then
    t1 = t
    End If

    lastest_folder = t1

    End Function

    Function PickFolder(strStartDir As Variant) As String

    Application.DisplayAlerts = False
    Dim SA As Object, f As Object
    Set SA = CreateObject("Shell.Application")
    Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)

    If (Not f Is Nothing) Then
    PickFolder = f.Items.Item.path
    End If

    Set f = Nothing
    Set SA = Nothing

    End Function


  2. #2
    Registered User
    Join Date
    06-29-2005
    Location
    England
    Posts
    50
    Help us a bit here.... What's the error, and which line of code does it error on?

  3. #3
    Registered User
    Join Date
    05-12-2005
    Posts
    68
    Sub ListFilesInFolder()

    Application.DisplayAlerts = False
    Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
    temp9, temp10, FILE_PATH As Variant
    Dim c As Integer
    Dim t1(20) As Variant
    Application.DisplayAlerts = False
    Dim path As Variant
    path = PickFolder("C:\") & "\"
    t = Dir(path & "*detail*.htm")
    Dim c1 As Integer

    While t <> ""
    t1(c1) = t
    t = Dir()
    c1 = c1 + 1
    Wend

    c = 0

    For I = 0 To 20
    If t1(I) = "" Then
    GoTo a:
    End If

    If c = 0 Then
    temp3 = path
    temp4 = Split(temp3, "\")
    temp5 = temp4(UBound(temp4) - 1)
    temp6 = lastest_folder(temp3, temp5) 'finds the latest folder that
    was created
    If temp6 <> "" Then
    temp10 = Split(temp6, temp5)
    temp7 = CInt(temp10(1)) <-------------------------------------------------------- error: type mismatch
    End If

    If Err.Description <> "" Then
    temp8 = 1
    temp9 = Format(temp8, "000#")
    Else
    temp8 = temp7 + 1
    temp9 = Format(temp8, "000#")
    End If

    MkDir temp3 & temp5 & temp9
    c = 1
    End If

    Workbooks.OpenText path & t1(I)
    ActiveWorkbook.SaveAs Filename:= _
    ActiveWorkbook.path & "\" & temp5 & temp9 & "\" &
    ActiveWorkbook.Name & ".xls", _
    FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Next

    Application.DisplayAlerts = True

    fill_file_names

    a:

    End Sub

    Function lastest_folder(p As Variant, ar2 As Variant)

    Dim t1 As Variant
    t = Dir(p & ar2 & "*.*", vbDirectory)

    While t <> ""
    If (t <> "") Then
    t1 = t
    End If
    t = Dir()
    Wend

    If t1 = "" Then
    t1 = t
    End If

    lastest_folder = t1

    End Function

    Function PickFolder(strStartDir As Variant) As String

    Application.DisplayAlerts = False
    Dim SA As Object, f As Object
    Set SA = CreateObject("Shell.Application")
    Set f = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)

    If (Not f Is Nothing) Then
    PickFolder = f.Items.Item.path
    End If

    Set f = Nothing
    Set SA = Nothing

    End Function

  4. #4
    Registered User
    Join Date
    06-29-2005
    Location
    England
    Posts
    50
    Hi Tim,

    The error is because the variant can't be changed to an Integer. Apologies for being blind before!!

    This means that your path string has fallen outside of the parameters that you originally used to create your algorithm to split it up.

    Have you walked through the code with the string that's causing the problem ? I find that generally helps.

    Rich

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1