Function SheetExistsSQL(Pp$, Sn$, Optional WD% = 1) ' wd =1 sheet 2 name
Dim FoundIt As Boolean
Dim cnn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
cnn.Open "Provider=MSDASQL.1;Data Source=" _
& "Excel Files;Initial Catalog=" & Pp
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
If WD = 1 Then
FoundIt = tbl.name = Sn & "$"
Else
FoundIt = tbl.name = Sn
End If
If FoundIt Then Exit For
Next tbl
SheetExistsSQL = FoundIt
Set cat = Nothing
cnn.Close
Set cnn = Nothing
End Function
Function SheetExists4M(PF$, Sn$, Optional Gv = "") As Boolean ' pathfile Name and Sheet Name
' Checks if sheet exists in a closed workbook
' about 30 times faster than the SQL look
'but
' the sql version can look at all the table and
' then collect a list of sheet and file names for later
'looking if file OR name exists
Dim p$, f$ ' path file ' or pass these as paramaters and PF = P & F
p = Left(PF, InStrRev(PF, "\")) ' path
f = Mid(PF, InStrRev(PF, "\") + 1) ' filename
' Make sure the file exists
If Dir(PF) = "" Then
MsgBox "File " & PF & " Not Found"
Exit Function
End If
' gets the value RV from specified R C if you need it
Gv = ExecuteExcel4Macro("'" & p & "[" & f & "]" & Sn & "'!R1C1")
SheetExists4M = CStr(Gv) <> "Error 2023"
End Function
Sub GetSheetsNames(Pp$)
' from path gets PsheetNa as sheets and pNameNa as Names
'ready to serch by instr() or splitto an array and match
'
cnn.Open "Provider=MSDASQL.1;Data Source=" _
& "Excel Files;Initial Catalog=" & Pp
cat.ActiveConnection = cnn
PsheetNa = ";": PNameNa = ";"
For Each tbl In cat.Tables
If Right(tbl.name, 1) = "$" Then
PsheetNa = PsheetNa & ";" & Left(tbl.name, Len(tbl.name) - 1)
Else
PNameNa = PNameNa & ";" & tbl.name
End If
' MsgBox tbl.Name
Next tbl
' to search as instr(cc ,";" & xxx & ";"
' as all have an ; on both sides
PsheetNa = PsheetNa & ";"
PNameNa = PNameNa & ";"
PPathGot = Pp
Set cat = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Public Sub GetRange(Pn$, ShtFromNa$, ShtToNa$, ADDR$)
Dim p$, f$, arg$
p = Left(Pn, InStrRev(Pn, "\")) ' path
f = Mid(Pn, InStrRev(Pn, "\") + 1) ' filename
arg = "='" & p & "[" & f & "]" & ShtFromNa & "'!" & "A1"
With Sheets(ShtToNa).Range(ADDR) 'set range to copy from / to.
.Formula = arg 'put formulae
.Value = .Value 'changes formula to value.
End With
End Sub