can any make a macro that can import all cdr files from 1folder to 1 file?
Cdr files to be imported contain only a page, or at least the same number of pages?
All them should be imported on the same layer? On the same page or on different pages?
Try this:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
Option Explicit Sub btImport() Dim NumFolder As String, fso As Object, f As Object, fc As Object, f1 As Object, Fis As String Dim M As Variant, El As Variant, NrPag As Long, Latime As Double, Inaltime As Double Dim Calea As String, extension As String 'Calea = "G:\TEC\Corel\Test Import" Calea = "C:" extension = "cdr" Dim impopt As StructImportOptions Set impopt = CreateStructImportOptions With impopt .MaintainLayers = True With .ColorConversionOptions .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 20%" .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%" End With End With Dim impflt As ImportFilter Set fso = CreateObject("Scripting.FileSystemObject") NumFolder = CorelScriptTools.GetFolder(Calea, "Select the folder to import cdr files") If NumFolder = "" Then End Set f = fso.GetFolder(NumFolder) Set fc = f.Files For Each f1 In fc If UCase(Right(f1.Name, Len(extension) + 1)) = UCase("." & extension) Then Fis = Fis & f1.Name & "|" End If Next M = Split(Fis, "|") ReDim Preserve M(UBound(M) - 1) 'eliminating "|" from the end... Latime = ActivePage.SizeWidth: Inaltime = ActivePage.SizeHeight Application.Optimization = True For Each El In M If NrPag = 0 Then ActivePage.Layers("Layer 1").Activate Set impflt = ActivePage.Layers("Layer 1").ImportEx(NumFolder & "\" & El, cdrCDR, impopt) impflt.Finish Else ActiveDocument.AddPagesEx 1, Latime, Inaltime Set impflt = ActivePage.Layers("Layer 1").ImportEx(NumFolder & "\" & El, cdrCDR, impopt) impflt.Finish End If NrPag = NrPag + 1 Next Application.Optimization = False ActiveWindow.Refresh Application.Refresh End Sub
Does it work as you like?
If you will always import cdr files from the same folder you can define the path in the line 9 (Calea = "C:\Corel\ImportFolder")...
Code solving item 1 and 2:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
Option Explicit Sub btImport() Dim NumFolder As String, fso As Object, f As Object, fc As Object, f1 As Object, Fis As String Dim M As Variant, El As Variant, NrPag As Long, Latime As Double, Inaltime As Double Dim Calea As String, extension As String, Pag As Page Calea = "G:\TEC\Corel\Test Import" extension = "cdr" Dim impopt As StructImportOptions Set impopt = CreateStructImportOptions With impopt .MaintainLayers = True With .ColorConversionOptions .SourceColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 20%" .TargetColorProfileList = "sRGB IEC61966-2.1,ISO Coated v2 (ECI),Dot Gain 15%" End With End With Dim impflt As ImportFilter Set fso = CreateObject("Scripting.FileSystemObject") NumFolder = CorelScriptTools.GetFolder(Calea, "Select the folder to import cdr files") If NumFolder = "" Then End Set f = fso.GetFolder(NumFolder) Set fc = f.Files For Each f1 In fc If UCase(Right(f1.Name, Len(extension) + 1)) = UCase("." & extension) Then Fis = Fis & f1.Name & "|" End If Next M = Split(Fis, "|") ReDim Preserve M(UBound(M) - 1) 'eliminating "|" from the end... Latime = ActivePage.SizeWidth: Inaltime = ActivePage.SizeHeight Application.Optimization = True For Each El In M If NrPag = 0 Then ActivePage.Name = El ActivePage.Layers("Layer 1").Activate Set impflt = ActivePage.Layers("Layer 1").ImportEx(NumFolder & "\" & El, cdrCDR, impopt) impflt.Finish Else Set Pag = ActiveDocument.AddPagesEx(1, Latime, Inaltime) Pag.Name = El Set impflt = ActivePage.Layers("Layer 1").ImportEx(NumFolder & "\" & El, cdrCDR, impopt) impflt.Finish End If NrPag = NrPag + 1 Next TestNaming Application.Optimization = False ActiveWindow.Refresh Application.Refresh End Sub Sub TestNaming() Dim P As Page, Pag As Page, D As Document, i As Long, NrPag As Long, PName As String, IndexOK As Long Set D = ActiveDocument: NrPag = 2 For Each P In D.Pages If IndexOK >= P.Index Then GoTo Over If Left(P.Name, 4) <> "Page" Then PName = P.Name P.Name = PName & " - Page 1" For i = P.Index + 1 To D.Pages.Count If Left(D.Pages.Item(i).Name, 4) = "Page" Then D.Pages.Item(i).Name = PName & " - Page " & NrPag: IndexOK = i: NrPag = NrPag + 1 Else NrPag = 2: Exit For End If Next i End If Over: Next End Sub
For the last item do you like to learn some VBA or you need the solution? Can you try something involving a listBox to load all the files in the folder, with double click moving in another listBox the selected items (files) and after that importing just the selected items from the second listBox, using the logic presented above...?
I am just using VBA like hobby in order to rapidly solve some repetitive tasks. My taks... I like helping and I asked you the previous question in order to know what do you really want. To learn or to use a solution...
honestly i need solution for that. normally if i am working on a project then i have to work with almost 20-100 files in 1 project, lots of action has to apply on all files and after applying all the actions i export that to pdf and print them. i have 1 more question if you dont mind when i use macro to import files this makes much time then normal means when i am manually importing files ?
and what this test naming do in the macro ?