Consulting

Results 1 to 5 of 5

Thread: Copy without using the clipboard

  1. #1
    VBAX Newbie
    Joined
    Jun 2007
    Posts
    4
    Location

    Copy without using the clipboard

    Hello, first of all I want to thank you all ,this forum is amazing.
    It helped me to write a program that copies data from separate files, and pastes then into the master excel file in order to do the calculations.
    My only problem is after each pasting operation, a window pops up asking me whether or not to save the information on the clipboard as there is alot of information. Is there a way to paste without using the clipboard so it doesn't get full and that I don't need to click on no so many times?

    Would posting the code would be of any help (it's not pretty, I used a lot of macro recording)

    Thank you.

  2. #2
    VBAX Newbie
    Joined
    Jun 2007
    Posts
    4
    Location
    I just found out, I just added
    Application.CutCopyMode = False
    after each pasting operation.

    Thanks, sorry for the intrusion.

  3. #3
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi bartyb
    Welcome to VBAX
    Feel free to post your code anyway. Recorded code is not usually the most efficient, and you should get some pointers for tidying it up.
    Regards
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  4. #4
    VBAX Newbie
    Joined
    Jun 2007
    Posts
    4
    Location
    Thank you very much for the warm welcome, I am very new to this, and this forum is an great palce to learn, I thank you for this.

    I would still require some help if possible, I used the first code as found on this forum, to get the files names in a folder and paste them in an array, and
    I did use the recoding for the remaning of the code. My issue now is how to use the files names in the array to process the data (copy in master file for calculations) in order to open those files and do the operations, as during recording I simply opened the file using open....

    So basically, I'd like to open the files in the folder (or in the array) in alphabetical order and replace each:

    ChDir "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test"
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121153.07",

    by the code opening the right file, as with this above it will always open 06121153.07 instead of the files in the array. There will always be 13 files to open. And then on the next operation it should open the next file in the array (or the next file in the folder).

    [VBA]Option Compare Text
    Option Explicit
    'The following is a function to call the directory browse window
    Private Const BIF_RETURNONLYFSDIRS As Long = &H1
    Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
    Private Const BIF_RETURNFSANCESTORS As Long = &H8
    Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
    Private Const BIF_BROWSEFORPRINTER As Long = &H2000
    Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
    Private Const MAX_PATH As Long = 260

    Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type

    Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
    End Type

    Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
    ByVal pidl As Long, _
    ByVal pszBuffer As String) As Long
    Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
    lpBrowseInfo As BrowseInfo) As Long

    Function BrowseFolder(Optional Caption As String = "") As String

    Dim BrowseInfo As BrowseInfo
    Dim FolderName As String
    Dim ID As Long
    Dim Res As Long

    With BrowseInfo
    .hOwner = 0
    .pidlRoot = 0
    .pszDisplayName = String$(MAX_PATH, vbNullChar)
    .lpszINSTRUCTIONS = Caption
    .ulFlags = BIF_RETURNONLYFSDIRS
    .lpfn = 0
    End With
    FolderName = String$(MAX_PATH, vbNullChar)
    ID = SHBrowseForFolderA(BrowseInfo)
    If ID Then
    Res = SHGetPathFromIDListA(ID, FolderName)
    If Res Then
    BrowseFolder = Left$(FolderName, InStr(FolderName, _
    vbNullChar) - 1)
    End If
    End If

    End Function

    Sub SixModeTest()
    Dim i As Long
    Dim Path As String
    Dim Prompt As String
    Dim Title As String
    Dim TempArr() As String
    With Application.FileSearch

    'Presently using the BrowseFolder function
    'Comment the following code out to use a fixed path
    'or to look in the path where this workbook resides
    Path = BrowseFolder("Select A Folder")
    If Path = "" Then
    Exit Sub
    Else
    .LookIn = Path
    'If you comment out the preceding code, uncomment one of the
    'following two lines
    ' .LookIn = "F:\Temp\"
    ' .LookIn = ThisWorkbook.Path 'Change to root path
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = True
    .Execute
    'If you comment out the path code using the function
    'then you will need to comment the following End If also
    End If
    For i = 1 To .FoundFiles.Count

    TempArr = Split(.FoundFiles(i), Application.PathSeparator)
    Range("A" & i).Resize(1, UBound(TempArr) + 1) = TempArr
    'comment the two lines above and the Dim TempArr() As String at the beginning of sub
    'and uncomment the line below to use this without putting
    'each directory in a seperate cell
    ' Range("A" & i).Value = .FoundFiles(i)

    Next i
    End With
    Columns.AutoFit





    ChDir "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test"
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121153.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("1-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121153.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121158.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("1-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121158.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121202.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("2-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121202.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121207.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("2-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121207.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121211.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("3-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121211.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121216.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("3-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121216.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121220.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("4-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121220.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121225.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("4-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121225.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121228.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("5-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121228.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121233.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("5-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121233.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121236.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("6-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121236.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121242.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("6-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121242.07").Activate
    ActiveWorkbook.Close
    Workbooks.OpenText Filename:= _
    "C:\Documents and Settings\bobarb\Desktop\Newest 6 mode test\06121252.07", _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("New HondaJune_12_2007_cat_test3.xls").Activate
    Sheets("ambient").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("06121252.07").Activate
    ActiveWorkbook.Close

    Sheets("Util calculations").Select
    ActiveWorkbook.Save
    End Sub[/VBA]

    I apologize, I know the code is dirty, but it just has to work.
    Many thanks.

  5. #5
    VBAX Newbie
    Joined
    Jun 2007
    Posts
    4
    Location
    I have this so far, I changed the first code so that is makes writes in excel the full path and filename in column 1, and in the remaining colum it separates the path, so that in the last row is the filename with its extension.

    But I have an error with the following:
    [vba]Windows("" & Range("A14").End(xlToRight)).Activate[/vba]
    which is always the master file doing the calculations.


    [vba] Option Compare Text
    Option Explicit
    'The following is a function to call the directory browse window
    Private Const BIF_RETURNONLYFSDIRS As Long = &H1
    Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
    Private Const BIF_RETURNFSANCESTORS As Long = &H8
    Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
    Private Const BIF_BROWSEFORPRINTER As Long = &H2000
    Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
    Private Const MAX_PATH As Long = 260

    Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type

    Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
    End Type

    Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
    ByVal pidl As Long, _
    ByVal pszBuffer As String) As Long
    Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
    lpBrowseInfo As BrowseInfo) As Long

    Function BrowseFolder(Optional Caption As String = "") As String

    Dim BrowseInfo As BrowseInfo
    Dim FolderName As String
    Dim ID As Long
    Dim Res As Long

    With BrowseInfo
    .hOwner = 0
    .pidlRoot = 0
    .pszDisplayName = String$(MAX_PATH, vbNullChar)
    .lpszINSTRUCTIONS = Caption
    .ulFlags = BIF_RETURNONLYFSDIRS
    .lpfn = 0
    End With
    FolderName = String$(MAX_PATH, vbNullChar)
    ID = SHBrowseForFolderA(BrowseInfo)
    If ID Then
    Res = SHGetPathFromIDListA(ID, FolderName)
    If Res Then
    BrowseFolder = Left$(FolderName, InStr(FolderName, _
    vbNullChar) - 1)
    End If
    End If

    End Function

    Sub SixModeTest()
    Dim i As Long
    Dim Path As String
    Dim Prompt As String
    Dim Title As String
    Dim TempArr() As String
    With Application.FileSearch

    'Presently using the BrowseFolder function
    'Comment the following code out to use a fixed path
    'or to look in the path where this workbook resides
    Path = BrowseFolder("Select A Folder")
    If Path = "" Then
    Exit Sub
    Else
    .LookIn = Path
    'If you comment out the preceding code, uncomment one of the
    'following two lines
    ' .LookIn = "F:\Temp\"
    ' .LookIn = ThisWorkbook.Path 'Change to root path
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = True
    .Execute
    'If you comment out the path code using the function
    'then you will need to comment the following End If also
    End If
    For i = 1 To .FoundFiles.Count

    TempArr = Split(.FoundFiles(i), Application.PathSeparator)
    Range("A" & i).Resize(1, UBound(TempArr) + 1) = TempArr
    'comment the two lines above and the Dim TempArr() As String at the beginning of sub
    'and uncomment the line below to use this without putting
    'each directory in a seperate cell
    Range("A" & i).Value = .FoundFiles(i)

    Next i
    End With
    Columns.AutoFit




    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A1"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("1-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A1").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A2"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("1-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A2").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A3"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("2-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A3").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A4"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("2-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A4").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A5"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("3-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A5").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A6"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("3-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A6").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A7"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("4-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A7").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A8"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("4-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A8").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A9"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("5-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A9").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A10"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("5-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A10").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A11"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
    , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
    Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
    28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
    Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
    41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
    Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
    54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
    Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("6-con").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A11").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A12"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("6-sum").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A12").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("FileNames").Select
    Workbooks.OpenText Filename:= _
    "" & Range("A13"), _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("" & Range("A14").End(xlToRight)).Activate
    Sheets("ambient").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("" & Range("A13").End(xlToRight)).Activate
    ActiveWorkbook.Close
    Sheets("Util calculations").Select
    ActiveWorkbook.Save
    End Sub[/vba]

    Thanks

Posting Permissions

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