Code Help

[Steve Voltage]

Can anyone please tell me why i get the message "compile error : Sub or Function not defined" and the following text is the highlighted "SHGetPathFromIDList"

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, sPath 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
sPath = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal sPath)
If r Then
pos = InStr(sPath, Chr$(0))
GetDirectory = Left(sPath, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub CombineFiles()

Dim sPath As String, FileName As String
Dim iDestRow As Long, iCopyLastRow As Long, iCopyLastCol As Long
Dim wbCopy As Workbook, wsCopy As Worksheet
Dim wbDest As Workbook, wsDest As Worksheet
Dim ThisWB As String, bOpen As Boolean


Call TOGGLEEVENTS(False)
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Sheets(1) '### CHANGE AS NECESSARY
Let ThisWB = ThisWorkbook.Name
Let sPath = GetDirectory
Let FileName = Dir(sPath & "\*.csv", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then

If ISWBOPEN(FileName) = True Then
Set wbCopy = Workbooks(FileName)
Let bOpen = True
Else
Set wbCopy = Workbooks.Open(FileName:=sPath & "\" & FileName)
Let bOpen = False
End If

For Each wsCopy In wbCopy.Worksheets
On Error Resume Next 'for blank sheet
Let iDestRow = wsDest.Cells.Find(What:="*", After:=wsDest.Cells(1, 1), SearchDirection:=xlPrevious).Row + 1
If iDestRow = 0 Then iDestRow = 1
On Error GoTo 0
Let iCopyLastRow = wsCopy.Cells.Find(What:="*", After:=wsCopy.Cells(1, 1), SearchDirection:=xlPrevious).Row
Let iCopyLastCol = wsCopy.Cells.Find(What:="*", After:=wsCopy.Cells(1, 1), SearchDirection:=xlPrevious).Column
If WorksheetFunction.CountA(wsCopy.Cells) = 0 Then
Else
wsCopy.Range("A1", wsCopy.Cells(iCopyLastRow, iCopyLastCol)).Copy wsDest.Cells(iDestRow, 1)
End If
Next wsCopy

If bOpen = False Then wbCopy.Close (False)
End If
FileName = Dir()
Loop

Call TOGGLEEVENTS(True)

End Sub

Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
End With
End Sub

Public Function ISWBOPEN(wbName As String) As Boolean
'Originally found written by Jake Marx
On Error Resume Next
ISWBOPEN = Len(Workbooks(wbName).Name)
End Function

[GaryRussell]

On the declare statement an alias is used, therefore the statement that gives the error should read as follows.

Code: Select all

r = SHGetPathFromIDListA(ByVal x, ByVal sPath)

[Steve Voltage]

On the declare statement an alias is used, therefore the statement that gives the error should read as follows.

Code: Select all

r = SHGetPathFromIDListA(ByVal x, ByVal sPath)

Hi Gary thanks for the reply, but i still get the same problem.

[Steve Voltage]

I think a need shell32.dll file to make this code work but i cannot seem to be able to download this

[osknows]

Where have you placed the code? It should be in a module and not a worksheet object; a function cannot be of type Public unless it's in a module

The shell32.dll is in Tools/References/Microsoft SHell Controls and automation

[Steve Voltage]

Where have you placed the code? It should be in a module and not a worksheet object; a function cannot be of type Public unless it's in a module

The shell32.dll is in Tools/References/Microsoft SHell Controls and automation

Where is Tools/References/Microsoft SHell Controls and automation in excel 2007 please m8?

[Steve Voltage]

Where have you placed the code? It should be in a module and not a worksheet object; a function cannot be of type Public unless it's in a module

The shell32.dll is in Tools/References/Microsoft SHell Controls and automation

Where is Tools/References/Microsoft SHell Controls and automation in excel 2007 please m8?

OK found and ticked that but still the same problem. This code is supposed to open all the csv files in a folder into sheet1 of this workbook. The idea making downloading Betfair sp easier rather than copy/paste each csv file. The original workbook for normal excel files works well and can be found here:http://www.vbaexpress.com/kb/getarticle.php?kb_id=829

[osknows]

Your code works fine for me

The code is in a module and I have the following references checked only

Visual Basic for applications
Microsoft Excel 11.0 Object Library
OLE automation

[Steve Voltage]

Your code works fine for me

The code is in a module and I have the following references checked only

Visual Basic for applications
Microsoft Excel 11.0 Object Library
OLE automation

Glad to hear it mate i have the following ticked:

Visual Basic for applications
Microsoft Excel 12.0 Object Library
OLE automation
Microsoft Office 12.0 Object Library
Microsoft Shell Controls And Automation

still don't bloody work

[osknows]

If it's BFSP prices I use the attached code to extract into a single sheet

Code: Select all

Sub Data_Extract()
Application.EnableEvents = False

'The following bit sets the dimensions for the data - i.e. defining which data to collect and how.

Dim fs, f, f1, fc, s, FilePath
Dim Datastore(250, 4) As Variant



'This bit finds the directory that the files are stored in.
With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
'This finds the last file in the directory - and then sets the file paths.

For lngCount = 1 To .SelectedItems.Count
            EndofPath = InStrRev(.SelectedItems(lngCount), "\")
            FilePath = Left(.SelectedItems(lngCount), EndofPath)
        Next lngCount
End With
'This sets the variables to find each file.


Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(FilePath)
    Set fc = f.Files
 
'This selects the relevant data - and gives it a defined name.

         For Each f1 In fc
         lrow = ""
         lrow2 = ""
        excelfile = f1.Name
        Workbooks.Open Filename:=FilePath & excelfile ', UpdateLinks:=False
        ActiveWorkbook.Worksheets(1).Select
       
        lrow = Cells(Rows.Count, 1).End(xlUp).Row
        If lrow >= 2 Then
        Rows("2:" & lrow).Select
        Selection.Copy
       
       
Application.Workbooks("BFSP Extract.xlsm").Activate
Application.Sheets("BFSP Data").Activate

lrow2 = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Rows(lrow2).Select
    ActiveSheet.Paste
    Range("R" & lrow2 & ":" & "R" & (lrow - 2 + lrow2)).Value = excelfile
    Range("A1:A200000").Activate
    Selection.RowHeight = 12.75
   
    End If
    Application.Workbooks(excelfile).Activate
    Application.DisplayAlerts = False
        ActiveWorkbook.Close savechanges:=False
    Application.DisplayAlerts = True
       
        Next



   
Application.EnableEvents = True

End Sub



Rename the workbook and worksheet to "BFSP Extract.xlsm" and "BFSP Data" or change the following to suit

Application.Workbooks("BFSP Extract.xlsm").Activate
Application.Sheets("BFSP Data").Activate

[Steve Voltage]

osknows thats great. with your sheet i get "run time error 429: ActiveX component can not create object.

when i debug i get:

Set fs = CreateObject("Scripting.FileSystemObject")




arrrrrrrrrrrggggggggghhhhhhhhhh

[osknows]

Try this file - Run the code in the module, point it at your csv files an see what happens.

This definitely works for me
http://www.mediafire.com/file/nzzr2ziun2d/BFSP Extract.xls

[osknows]

What version of excel are you using?

[Steve Voltage]

Try this file - Run the code in the module, point it at your csv files an see what happens.

This definitely works for me
http://www.mediafire.com/file/nzzr2ziun2d/BFSP Extract.xls

Thanks m8, still get the same error though thanks for helping.

[osknows]

This may be of use http://support.microsoft.com/kb/828550