I am trying to set password on all excel files in a particular directory. I tried following code but unfortunately it doesn't set password. I can see it opening and closing files but it still doesn't ask for a password when I open files manually.
Sub LoopThroughFiles()
Dim StrFolder As String
Dim StrFile As String
StrFolder = "S:\lnb\SecPFM\REPORTS\CRC\201608\"
StrFile = Dir(StrFolder & "*xls*")
Do While Len(StrFile) > 0
Workbooks.Open Filename:=StrFolder & StrFile, Password:="OpenFile"
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=True
StrFile = Dir
Loop
End Sub
Any idea what am I doing wrong here ? This is with Excel 2010
I do not believe you can set a file password without saving.
So in this instance you will need to SaveAs.
Option Explicit
Sub LoopThroughFiles()
Dim StrFolder As String
Dim StrFile As String
Dim wb As Workbook
StrFolder = "S:\lnb\SecPFM\REPORTS\CRC\201608\"
StrFile = Dir(StrFolder & "*xls*")
Do While Len(StrFile) > 0
Set wb = Workbooks.Open(Filename:=StrFolder & StrFile)
With wb
.SaveAs .Path & "\protected_" & .Name, xlExcel12, "OpenFile"
End With
Application.DisplayAlerts = False
ActiveWorkbook.Close Savechanges:=True
StrFile = Dir
Loop
End Sub
You can even just override the existing file if you don't want to create a new protected version:
Application.DisplayAlerts = False
Do While Len(StrFile) > 0
Set wb = Workbooks.Open(Filename:=StrFolder & StrFile)
With wb
.SaveAs .FullName, , "OpenFile"
End With
ActiveWorkbook.Close Savechanges:=True
StrFile = Dir
Loop
Application.DisplayAlerts = True
Related
I have a about 40 files that are IQy files that I can open with Excel and I'm trying to go through all of them and save them as xlsx files. What I have so far in VBA is this
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads"
Filename = Dir(Pathname & ".iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx"
wb.Close
Filename = Dir()
Loop
End Sub
To my understanding this loops through my download file where the iqy files are stored and then saveas in xlsx format. When I run it nothing happens.
UPDATE
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=51
wb.Close
Filename = Dir()
Loop
End Sub
This is what worked for me, the only problem I have now is after it changes every file I get a prompt to import data and all I have to press is ok. Is there a way to automate this part so that I can import the data using the table option.
You need to include a wildcard in order to find your iqy files and your pathname will need an additional folder separator to allow the Open and SaveAs to work:
Sub ConvertFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = "C:\Users\CHI86786\Downloads\"
Filename = Dir(Pathname & "*.iqy")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.SaveAs Pathname & Filename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close
Filename = Dir()
Loop
End Sub
Lastly, to be sure it saves correctly, set the FileFormat parameter when using SaveAs.
how can I change the format from xlsm to xlsx. I need a script that will save a copy of the xlsm file with xlsx extension, but doesn't ask user to input file name, it needs to keep the original name, the only thing the user needs to do is select where to save the file.
Sub changeext()
Dim s_as As String
s_as = ThisWorkbook.FullName
s_as = Left(s_as, InStrRev(s_as, ".") - 1) & ".xlsx"
ThisWorkbook.SaveAs FileName:=s_as
Application.DisplayAlerts = False
End Sub
I think you only want to add a .xlxs copy not write over your macro enabled workbook. Try the below line of code, it should work, put your workbook name in "put Workbook name here", the file left open will be the .xlsx file.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & "Put Workbook Name here" & ".xlsx", FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
You need to create FolderPicker Function:
Sub changeext()
Dim objFolder As Object, objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ChooseFolder)
ThisWorkbook.SaveCopyAs Filename:=objFolder & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "xlsx"
End Sub
Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to save down the copy of this workbook"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
On a monthly basis I have to aggregate daily files. The issue is I need the files to be in "TXT", but they are sent to me as "WRI".
I am able to do one file at a time if it is hardcoded with the following.
Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"
However, I want to be able to loop through the folder. But I am not sure how to change the code to allow it to loop.
Sub ConvertToTXT()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim strPath As String
Dim strFile As String
strPath = "C:\Users\John\Desktop\Folder1\" strFile = Dir(strPath & "*.wri")
Do While strFile <> ""
Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"
Loop
End Sub
I'd personally use the Scripting.FileSystemObject for this - it's much less prone to errors than manually building filepath strings. You'll need to add a reference to Microsoft Scripting Runtime:
Private Sub ConvertToTXT(filePath As String)
With New Scripting.FileSystemObject
Dim directory As Folder
Set directory = .GetFolder(filePath)
Dim target As File
For Each target In directory.Files
If LCase$(.GetExtensionName(target.Name)) = "wri" Then
Dim newName As String
newName = .BuildPath(filePath, .GetBaseName(target.Name)) & ".txt"
.MoveFile target.Path, newName
End If
Next
End With
End Sub
Call it by passing it the directory you want to perform the renaming in:
ConvertToTXT "C:\Users\John\Desktop\Folder1"
Note that is doesn't care if there's a trailing \ or not - this also works:
ConvertToTXT "C:\Users\John\Desktop\Folder1\"
Sub ConvertToTXT()
Const strPath As String = "C:\Users\John\Desktop\Folder1"
Dim strFile As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strFile = Dir(strPath & "\" & "*.wri")
Do While strFile <> ""
Name strPath & "\" & strFile As strPath & "\" & Replace(strFile, ".wri", ".txt")
strFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I would like to convert all XLSX files in a certain directory to CSV files. Each resulting CSV file should only contain the first worksheet of the XLSX file and be saved in a subfolder of the directory.
I am using the following script which works fine, except that it saves all worksheets as a separate CSV. I just need the first.
Could someone tell me how to modify the script? I have very little experience with VBA.
Sub Loop_Through_Files()
Dim WS As Excel.Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myExtension = "*.xl??"
myPath = ActiveWorkbook.Path
myFile = Dir(myPath & "\" & "Input" & "\" & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Open workbook
Set x = Workbooks.Open(Filename:=myPath & "\" & "Input" & "\" & myFile)
SaveToDirectory = ActiveWorkbook.Path
For Each WS In x.Worksheets
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
Next
x.Close SaveChanges:=True
'Get next file name
myFile = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Replace your for loop with this:
WS = x.Sheets(1)
WS.SaveAs SaveToDirectory & Left(x.Name, InStr(x.Name, ".") - 1) & "_" & WS.Name, xlCSV
I have a folder which has .csv files, .xls files, and xlsx files. The below code is a portion of an overall project (when I remove the below code, the remaining code achieves what I want). A large chunk of the code was compiled from somewhere (here and around the internet). What I want the code to do is open only the .csv files in the folder, convert them to an Excel file, close the files, and then delete the .csv files in the folder. What ends up happening with the code is that one or both of the files created by the code are deleted from the folder, and I am left with nothing. Thanks in advance for any help.
Sub Test()
'
' Test Macro
'
'Set variables for the below loop
Dim MyFolder As String
Dim MyFile As String
Dim GetBook As String
Dim GetBook2 As String
Dim MyCSVFile As String
Dim KillFile As String
MyFolder = "REDACTED"
MyFile = Dir(MyFolder & "\*.xls")
MyCSVFile = Dir(MyFolder & "\*.csv")
'Open all of the .csv files in the folder and convert to .xls
Do While MyCSVFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyCSVFile
GetBook = ActiveWorkbook.Name
GetBook2 = Left(GetBook, Len(GetBook) - 4)
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetBook2, FileFormat:=56
ActiveWorkbook.Close False
Kill MyFolder & "\" & GetBook
Loop
End Sub
You are not calling the Dir function to get the next file.
Sub Test()
'Set variables for the below loop
Dim myFolder As String
Dim getBook As String
Dim myCSVFile As String
Application.DisplayAlerts = False
myFolder = Environ("TEMP") & Chr(92) & "REDACTED"
myCSVFile = Dir(myFolder & "\*.csv")
Do While myCSVFile <> ""
Workbooks.Open Filename:=myFolder & "\" & myCSVFile
getBook = ActiveSheet.Name '<~ Sheet1 of an opened CSV is the name of the CSV
ActiveSheet.Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=myFolder & Chr(92) & getBook, FileFormat:=56
ActiveWorkbook.Close False
Kill myFolder & Chr(92) & myCSVFile '<~~ delete the CSV, not the workbook
myCSVFile = Dir '<~~ this is important to get the next file in the folder listing
Loop
End Sub
The only worksheet in an opened CSV is named for the CSV (without the .CSV extension) so that can be used in the Workbook.SaveAs method. I've used xlOpenXMLWorkbook as the SaveAs FileFormat type.