Sub btnBrowse()
Dim s$, i%
On Error Resume Next
s = Application.CorelScriptTools.GetFileBox("CDR Files (*.cdr)|*.cdr", "Impot from...", 0, txPrefix, , cbFolder, "use this folder")
If s = sEmpty Then Exit Sub
cbFolder = XFilePath(s): chkDocFolder = False
If txPrefix = sEmpty Then txPrefix.Text = XFileName(s): _
i = InStrRev(txPrefix.Text, "."): If i > 0 Then txPrefix.Text = Left$(txPrefix.Text, i - 1)
End Sub
Function XFilePath$(ByVal FullName$)
Dim i&: i = InStrRev(FullName, "\"): XFilePath = Left$(FullName, i)
End Function
Function XFileName$(ByVal FullName$)
Dim i&: i = InStrRev(FullName, "\"): XFileName = Mid$(FullName, i + 1)
End Function
Function iFileCount(myPath As String)
Set FSO = CreateObject("Scripting.FileSystemObject")
iFileCount = FSO.GetFolder(myPath).Files.Count
s1 = FSO.GetFolder(myPath).SubFolders.Count
s2 = FSO.GetFolder(myPath).Size
End Function
Sub InsFilesFromFolder()
saveUnit = ActiveDocument.Unit: ActiveDocument.Unit = cdrMillimeter
Call btnBrowse
Call iImportFile(cbFolder, iFileCount(cbFolder))
End Sub
Sub iImportFile(myPath As String, NumberFile As Integer)
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim impopt As StructImportOptions
Dim iSpacePointer As Integer
Dim iPageName As String
Set impopt = CreateStructImportOptions
With impopt
.MaintainLayers = True
End With
Dim impflt As ImportFilter
Dim iFileName As String
Dim s1 As Shape
Dim iPageWidth As Double
Dim iPageHight As Double
iPageWidth = ActiveDocument.Pages(ActiveDocument.Pages.Count).SizeWidth
iPageHight = ActiveDocument.Pages(ActiveDocument.Pages.Count).SizeHeight
Dim p1 As Page
Set p1 = ActiveDocument.InsertPagesEx(1, False, ActiveDocument.Pages(ActiveDocument.Pages.Count).Index, iPageWidth, iPageHight)
Dim iFileCollection As Collection
Set iFileCollection = FilenamesCollection(myPath, ".cdr", 1)
For i = 1 To iFileCollection.Count
Set impflt = ActiveLayer.ImportEx(iFileCollection.Item(i), cdrCDR, impopt)
impflt.Finish
iPageName = Mid(iFileCollection.Item(i), Len(myPath) + 1, Len(iFileCollection.Item(i)) - Len(myPath) - 4)
If Len(iPageName) > 30 Then
iPageName = Left(iPageName, 30)
End If
ActiveDocument.Pages.Item(i + 1).Name = iPageName
Set p1 = ActiveDocument.InsertPagesEx(1, False, ActiveDocument.Pages(ActiveDocument.Pages.Count).Index, iPageWidth, iPageHight)
Next i
ActiveDocument.Pages(ActiveDocument.Pages.Count).Delete
End Sub