+ Reply to Thread
Results 1 to 1 of 1

Problem with code at Mac

  1. #1
    Registered User
    Join Date
    09-05-2013
    Location
    Croatia
    MS-Off Ver
    Excel 2010
    Posts
    2

    Problem with code at Mac

    Hi all

    I have a problem

    I have this code
    Option Explicit


    '32-bit API declarations
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
    pszpath As String) As Long


    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
    As Long


    Public Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type


    Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo As BrowseInfo
    Dim path As String
    Dim r As Long, x As Long, pos As Integer


    'Root folder = Desktop
    bInfo.pIDLRoot = 0&


    'Title in the dialog
    If IsMissing(msg) Then
    bInfo.lpszTitle = "Please select the folder of the excel files to copy."
    Else
    bInfo.lpszTitle = msg
    End If


    'Type of directory to return
    bInfo.ulFlags = &H1


    'Display the dialog
    x = SHBrowseForFolder(bInfo)


    'Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
    pos = InStr(path, Chr$(0))
    GetDirectory = Left(path, pos - 1)
    Else
    GetDirectory = ""
    End If
    End Function


    Sub CombineFiles()
    Dim path As String
    Dim FileName As String
    Dim LastCell As Range
    Dim Wkb As Workbook
    Dim ws As Worksheet
    Dim ThisWB As String


    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = GetDirectory
    FileName = Dir(path & "\*.xls", vbNormal)
    Do Until FileName = ""
    If FileName <> ThisWB Then
    Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
    For Each ws In Wkb.Worksheets
    Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
    If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
    Else
    ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    End If
    Next ws
    Wkb.Close False
    End If
    FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True


    Set Wkb = Nothing
    Set LastCell = Nothing
    End Sub

    And it works ok. It imports data from multiply excels in one folder. But when I send that file to one person what has MAC it doesnt work.

    Can someone fix code for MAC? Or at least some solution for it

    Thanks

    P.S. I post this on 2 forums because I am kinda in hurry. Thanks

    Dont mind about formula at first sheet
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. [SOLVED] Code Problem: How to Write this into a VBA code
    By rlkerr in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 08-28-2013, 02:46 AM
  2. Replies: 2
    Last Post: 01-22-2013, 07:09 AM
  3. VBA and formula conflict
    By Quicksnot in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 10-17-2012, 08:03 PM
  4. Problem with code
    By satisha11 in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 04-17-2012, 11:10 PM
  5. Code problem.
    By Flower R in forum Excel General
    Replies: 0
    Last Post: 12-15-2008, 09:42 PM

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