open file from folder save in new folder

T

tim64

I have this code and I want it to open a file in a directory that I
choose (it does that already), and then I wunt it to create a
sub-folder in the folder I chose with the original folders name plus a
number. (example) I choose a folder named project_test then it converts
the file, in the folder, detail.htm to detail.htm.wk4. Then it creates
the sub-folder project_test0001 then saves detail.htm.wk4 in it. Then
the next time I run ConvertFiles ,when it creates the sub-folder, it
creates project_test0002, and when it has reached the tenth time it
creates it as project_test0010 etc.



Code:
--------------------


Sub ConvertFiles()
'
'
Application.DisplayAlerts = False

'
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String


NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
NextFile & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()


Loop
Next
End If

Application.DisplayAlerts = True


End Sub
 
A

anilsolipuram

Backup the workbooks before testing this macro

Excel version I have is 2000 so couldnot test the macro



Sub ConvertFiles()
'
'
Application.DisplayAlerts = False
Dim T As Integer
'
T = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String
T = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile

If T < 10 Then
MkDir ActiveWorkbook.Path & "\ PROJECT_TEST000" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\ PROJECT_TEST000" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MkDir ActiveWorkbook.Path & "\ PROJECT_TEST00" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\ PROJECT_TEST00" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
T = T + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub
 
T

tim64

it looks good, but I don't have a folder named project_test that wa
for an example, I'll have hundreds of different folders I'll use thi
in and, I'll have between 1 and 10 files in then with the name "detail
in it and, I wunt them all to go to the new folder that is created. Als
I'll probly have hundreds of folders created because I'm going to us
this alot so it will be like project_test1839(example) eventually.
Sorry I didn't clerify that earlie
 
A

anilsolipuram

Backup your workbooks before using this macro
Try this macro

Sub ConvertFiles()
'
'
Application.DisplayAlerts = False
Dim T As Integer
'
T = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String
T = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile

If T < 10 Then
MkDir ActiveWorkbook.Path & "\" & ar2 & "000" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & "000" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MkDir ActiveWorkbook.Path & "\" & ar2 & "00" & T
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & "00" & T & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
T = T + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub
 
T

tim64

thats almost to what I want but, when ConvertFiles runs I only want i
to create one sub-folder per run and I want all the converted files t
go into it. (example) I have four files detail1.htm, detail2.htm
detail3.htm, detail4.htm and, in the folder project_test there ar
sub-folders project_test0001 - project_test3829. So when I ru
ConvertFiles it converts the four files then it saves them to th
folder project_test3830 (after it makes it). So the next time I ru
ConvertFiles it saves the files in project_test3831 etc
 
A

anilsolipuram

I added 1 more function to the end



Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
temp2 = CInt(temp1(1))
temp3 = temp1 + 1
temp4 = Format(temp3, "000#")
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
t = Dir()
If (t <> "") Then
t1 = t
End If
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
T

tim64

I got an error (see below)



Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
temp2 = CInt(temp1(1))
<-------------------------------------------Run-time error '9':
subscript out of range
temp3 = temp1 + 1

temp4 = Format(temp3, "000#")
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
t = Dir()
If (t <> "") Then
t1 = t
End If
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
A

anilsolipuram

Backup the workbooks before using the macros.

Since I don't have excel 2002, i am not testing the code before pasting
it.


Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(ActiveWorkbook.Path & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<>"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir ActiveWorkbook.Path & "\" & ar2 & temp4
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
t = Dir()
If (t <> "") Then
t1 = t
End If
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
T

tim64

the code dosen't work
1. it doesn't save as a wk4 file
2. it doesn't create a sub-folder
3. it goes in a constant loop of opening the same file and closeing it
over and over again

mabye it's because of the runtime error that poped up earlier(it
doesn't anymore though)
 
A

anilsolipuram

try it now

Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(fd.SelectedItems(a) & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<>"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir fd.SelectedItems(a) & "\" & ar2 & temp4
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
t = Dir()
If (t <> "") Then
t1 = t
End If
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
T

tim64

it's good but it only creates the sub-folder one time
(example) I run ConvertFiles and it creates project_test0001 and puts
the converted files in it. the second time I run ConvertFiles it
doesn't make project_test0002 and puts the converted files in
project_test0001

also at the end it goes in a continuous loop of opening the same
"detail" files and saving them over and over again


Sub ConvertFiles()
'
'
Dim temp, temp1, temp2, temp3, temp4 As Variant
Application.DisplayAlerts = False
Dim t As Integer
'
t = 1
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
Dim NextFile As String
t = 1

NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Dim ar1, ar2 As Variant
ar1 = Split(fd.SelectedItems(a), "\")
ar2 = ar1(UBound(ar1))
temp = last_filename(fd.SelectedItems(a) & "\", ar2)
temp1 = Split(temp, ar2)
on error resume next
temp2 = CInt(temp1(1))
if err.description<>"" then
err.clear
temp3=1
temp4 = Format(temp3, "000#")
else
temp3 = temp2 + 1
temp4 = Format(temp3, "000#")
end if
MkDir fd.SelectedItems(a) & "\" & ar2 & temp4
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & ar2 & temp4 & "\" & ActiveWorkbook.Name &
".wk4", _ <----------------(it keeps looping here)
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()
t = t + 1

Loop
Next
End If

Application.DisplayAlerts = True


End Sub


Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
t = Dir()
If (t <> "") Then
t1 = t
End If
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
A

anilsolipuram

The code was not compatible in excel 2000, so had to change it make it
compatilbe to excel 2000

macro does:

1) open file dialog
2) go to file folder and select all the files you want to copy into new
created subfolder and click open.
3) creates new subfolder and copies selected files into new folder
4) next time you execute the macro, it would create subfolder like
project_file0001 then project_file0002 .......



Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8,
temp9, temp10, FILE_PATH As Variant
t = Application.GetOpenFilename(FileFilter:="HTML files (*.html),
*.htm", FilterIndex:=2, MultiSelect:=True)
If UBound(t) > 0 Then
teMp = Split(t(1), "\")
temp1 = teMp(UBound(teMp))
temp2 = Split(t(1), temp1)
temp3 = temp2(0)
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = last_filename(temp3, temp5)
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
For I = 1 To UBound(t)
Application.DisplayAlerts = False
Workbooks.OpenText t(I)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.Path & "\" & temp5 & temp9 & "\" &
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Next
End If
End Sub
Function last_filename(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Function
 
T

tim64

I works great, but there's one thing that I want. at the begining of th
code instead of you choosing the folder and the files in it,you choos
the folder and the program atuomaticly gets all the files that has th
word "detail" in it (like the code did originally), but otherwise i
works great. Thank you for helping me. I really appreciate it
 
A

anilsolipuram

Back up your workbook before executing this macro.

This is completely different solution, when you execute the macro i
will not popup filedialog , the macro will go to folder specified b
"path" variable and opens files like *detail*.htm, and does samethin
as the previous macro.







Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = "C:\Documents and Settings\Administrator\Desktop\webpages\
'path from which files will be extracted to should end with "\"
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = lastest_folder(temp3, temp5) 'finds the latest folde
that was created
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\"
ActiveWorkbook.Name & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True
End Sub
Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Functio
 
T

tim64

Sub ListFilesInFolder()
Dim teMp, temp1, temp2, temp3, temp4, temp5, temp6, temp7, temp8
temp9, temp10, FILE_PATH As Variant
Dim c As Integer
Dim t1(20) As Variant
Application.DisplayAlerts = False
Dim path As Variant
path = "C:\Documents and Settings\Administrator\Desktop\webpages\
<-------I don't want it to go there. I want to choose Where it goes
t = Dir(path & "*detail*.htm")
Dim c1 As Integer
While t <> ""
t1(c1) = t
t = Dir()
c1 = c1 + 1
Wend
c = 0
For i = 0 To 20
If t1(i) = "" Then
GoTo a:
End If
If c = 0 Then
temp3 = path
temp4 = Split(temp3, "\")
temp5 = temp4(UBound(temp4) - 1)
temp6 = lastest_folder(temp3, temp5) 'finds the latest folder that wa
created
If temp6 <> "" Then
temp10 = Split(temp6, temp5)
temp7 = CInt(temp10(1))
End If
If Err.Description <> "" Then
temp8 = 1
temp9 = Format(temp8, "000#")
Else
temp8 = temp7 + 1
temp9 = Format(temp8, "000#")
End If
MkDir temp3 & temp5 & temp9
c = 1
End If
Application.DisplayAlerts = False
Workbooks.OpenText path & t1(i)
ActiveWorkbook.SaveAs Filename:= _
ActiveWorkbook.path & "\" & temp5 & temp9 & "\" & ActiveWorkbook.Name
".xls", _
FileFormat:=xlExcel7, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
a:
Application.DisplayAlerts = True
End Sub
Function lastest_folder(p As Variant, ar2 As Variant)
Dim t1 As Variant
t = Dir(p & ar2 & "*.*", vbDirectory)
While t <> ""
If (t <> "") Then
t1 = t
End If
t = Dir()
Wend
If t1 = "" Then
t1 = t
End If
last_filename = t1
End Functio
 
T

tim64

a. do you mean this code
b. no I dont think so

Sub ConvertFiles()
'
'
Application.DisplayAlerts = False

'
Dim vrtSelectedItem As Variant

Dim FileToOpen As String
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Cool Application"
fd.InitialFileName = "Working"
If fd.Show = -1 Then
For a = 1 To fd.SelectedItems.Count
MsgBox fd.SelectedItems(a)
Dim NextFile As String


NextFile = Dir(fd.SelectedItems(a) & "\*detail*.htm")
Do While NextFile <> ""
Workbooks.Open Filename:=NextFile
ActiveWorkbook.SaveAs Filename:= _
NextFile & ".wk4", _
FileFormat:=xlWK4, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
NextFile = Dir()


Loop
Next
End If

Application.DisplayAlerts = True


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

open in old directory save in new directory 0
Normal.dot Error 3
VBA - exporting serial letters to single documents 0
Word macro that can call cells out of Excel for a find and replace 0
need VB list property for file contents 5
Need correct list property for coding a macro 1
File Dialog Folder Picker open to particular folder 2
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0

Top