I have an Excel file (https://www.dropbox.com/s/hv9u68s136es190/Example2.xlsx?dl=0) with in column A all the persons and in the cell next to there name text (column B).
I want to save for every person a text file containing the text in the cell next to there name.
The filename should be called like the persons name.
So in this case i would have three text files. I do not know how to manage this using VBA in Excel.
Can someone help me with this?
Try this code, please. But, you must initially try something on your own. We usually help people correct their code and learn...
The text files will be named like the people names in column A. The folder where they will be saved will be the one of the workbook which keeps the active sheet. You can define it as you need, of course.
Option Explicit
Sub SaveTxtNamePlusTekst()
Dim sh As Worksheet, lastR As Long, i As Long, strPath As String
Set sh = ActiveSheet ' use here the sheet you need
strPath = sh.Parent.path 'you can define here the path you wish...
If Dir(strpath, vbDirectory) = "" Then MsgBox "The folder path is not valid...": Exit Sub
lastR = sh.Range("A" & Cells.Rows.Count).End(xlUp).row 'Last row in A:A
For i = 2 To lastR
'calling a Sub able to create a text file in a folder and put text in it
WriteText sh.Range("A" & i).value, strPath, sh.Range("B" & i).value
Next i
End Sub
Private Sub WriteText(strName As String, strPath As String, strText As String)
Dim filePath As String
filePath = strPath & "\" & strName & ".txt" 'building the txt file path
FreeFile 1
Open filePath For Output As #1
Print #1, strText 'write the text
Close #1
End Sub
Related
I am trying to write a VBA macro to automatically update an excel column (E) of filenames representing a directory (C:\Directory) with any files (mostly pdf) that might have been added to that directory. This is the code I have so far:
Sub GetFileNames()
Dim sPath As String
Dim sFile As String
Dim Cl As Range
Dim Nme As String
'specify directory
sPath = "C:\Directory\"
With CreateObject("scripting.dictionary")
For Each Cl In Range("E3", Range("E" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
sFile = Dir(sPath)
Do While sFile <> ""
Nme = CreateObject("Scripting.FileSystemObject").GetBaseName(sFile)
If Not .exists(Nme) Then
Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Nme
End If
sFile = Dir ' Get next filename
Loop
End With
End Sub
Unforunatly I am not recieving the expected result. Instead of all missing files being added to the bottom of the column, only one file is added at a time when running the macro. It also adds files that are already in the column (Marked red in the screenshot below). Thanks for the help!
Image showing faulty cells being added
I need to add today's date to a file name.
I have part of the code copied from another file, but it doesn't have that feature.
Where it says "/CARYYMMDD2428395101.BCA" is the place that I need to change to today's date.
Sub Export_Selection_As_Fixed_Length_File()
' Dimension all variables.
Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String
Dim FileNum, ColumnCount, RowCount, FieldWidth As Integer
Dim sht As Worksheet
'Below are options incase you want to change the folder where VBA stores the .txt file
'We use ActiveWorkbook.Path in this example
'ActiveWorkbook.Path 'the activeworkbook
'ThisWorkbook.Path 'the workbook with the code
'CurDir 'the current directory (when you hit File|open)
'If a cell is blank, what character should be used instead
Filler_Char_To_Replace_Blanks = " "
'Check if the user has made any selection at all
If Selection.Cells.Count < 2 Then
MsgBox "No row has been selected"
Selection.Activate
End
End If
'This is the destination file name.
DestinationFile = ActiveWorkbook.Path & "/CARYYMMDD24284444101.BCA"
'Obtain next free file handle number.
FileNum = FreeFile()
I expect to get the name of the file as CAR19080824284444101.BCA
First I want to point out you qualified your variables incorrectly. The line Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String only declares Filler_Char_To_Replace_Blanks as a String the rest are Variant types.
Format(Date, "yyyymmdd") is what you're looking for you can change the format however, I demonstrate below another way to name, but if you like what I here just modify it.
Sub Export_Selection_As_Fixed_Length_File()
' Dim all variables.
Dim DestinationFile As String, CellValue As String, Filler_Char_To_Replace_Blanks As String
Dim FileNum As Integer, ColumnCount As Integer, RowCountAs Integer, FieldWidth As Integer
Dim sht As Worksheet
'Below are options incase you want to change the folder where VBA stores the .txt file
'We use ActiveWorkbook.Path in this example
'ActiveWorkbook.Path 'the activeworkbook
'ThisWorkbook.Path 'the workbook with the code
'CurDir 'the current directory (when you hit File|open)
'If a cell is blank, what character should be used instead
Filler_Char_To_Replace_Blanks = " "
'Check if the user has made any selection at all
If Selection.Cells.Count < 2 Then
MsgBox "No row has been selected"
Selection.Activate
End
End If
'This is the destination file name. Unsure if you wanted a certain format, but this shows you how to add it.
DestinationFile = ActiveWorkbook.Path & "/CARYYMMDD24284444101.BCA" & Month(Date) &"."&Year(Date)
'Obtain next free file handle number.
FileNum = FreeFile()
This is some pseudo-code, which saves 'ThisWorkbook' into the specified path (directory eg. C:\Test) and adds the date to the end of the filename.
ThisWorkbook.SaveCopyAs <declare_path_variable> & **Format(Date, "dd-mm-yyyy")** & ThisWorkbook.Name
You can do it like this:
'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr
I want to create folders with Excel, in a way that every time a make a new entry in the selected column, a new folder is created.
I already searched and found some codes to VBA that creates the folders. But I have to select the cells and then run the macro everytime. Is there any way that I can do that automatically?
Thank you in advance,
Leo
Below is the code for creating new folders (Sub directories)
Sub CreateFolder()
Dim caminho As String
Dim folder As Object, FolderName
For i = 1 To 500
Set folder = CreateObject("Scripting.FileSystemObject") FolderName = ActiveWorkbook.Path & "\" & Range("A" & i).Value
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
directory = ThisWorkbook.Path
Next i
End Sub
Yes, we can help you. Just need some pertinent info. Does the column need to be selected? Or can you work with a hard coded column? Say a column like Column D... We can put a Worksheet_Change macro on your worksheet module so that whenever a value in a certain column is changed - it will automatically check to see if that folder exists and if not then create it.
Here is an example that will create folders for any new or changed cells in column D:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim caminho As String
Dim folder As Object, FolderName
If Target.Column = 1 And Target.Value <> "" Then ' If Changed Cell is in Column A
' This code changes unacceptable file name characters with an underscore
Filename = Target.Value
MyArray = Array("<", ">", "|", "/", "*", "\", "?", """")
For X = LBound(MyArray) To UBound(MyArray)
Filename = Replace(Filename, MyArray(X), "_", 1)
Next X
' This code creates the folder if it doesn't already exist
Set folder = CreateObject("Scripting.FileSystemObject")
FolderName = ActiveWorkbook.Path & "\" & Filename
If Not folder.FolderExists(FolderName) Then
folder.CreateFolder (FolderName)
End If
End If
End Sub
I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problems should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:
Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant '<<does the list of passwords have to be array?
sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2" '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm" '<< how to make sFile be every file in folder?
' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False
End With
End Sub
For the password array I have tried following code:
Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next 'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i
End Sub
I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.
I have plain text titles in one .csv and hyperlinks for those titles in another .csv
I currently open them in the same work book, put the titles in A, the hyperlinks in H, and use
=HYPERLINK(H1,A1)
to get my final output of Titles with hyperlinks built in.
Is there an easy way (Excel VBA or macro) to bypass the manual work and create a new output file with the "Titles with hyperlinks built in" from the original two .csv files?
Edit: My two .csv files have the respective text (hyperlink and titles) all down column A.
Sub buildlinks()
Dim i As Integer
Dim wb1, wb2 As Workbook
Set wb1 = Application.Workbooks.Open("C:/path/Links.csv")
Set wb2 = Application.Workbooks.Open("C:/path/Titles.csv")
i = 1
Do Until wb1.Sheets("Sheet1Name").Cells(i, 1).Value = ""
ThisWorkbook.Sheets("Sheet1Name").Cells(i, 1).Formula = "=HYPERLINK(" & wb1.Sheets("Sheet1Name").Cells(i, 1).Value & "," & wb2.Sheets("Sheet1Name").Cells(i, 1).Value & ")"
i = i + 1
Loop
End Sub
Assuming you want to create the hyperlinks in the current spreadsheet instead of creating a separate file.
Since you've said that the inputs are really just text files, one item per line, not comma-separated, it's actually pretty simple to implement using the VBA file handling commands.
Sub BuildLinks(titlesFilePath as String, linksFilePath As String, ByVal rowStart As Long)
Dim tf As Long, lf As Long, of As Long
tf = FreeFile
On Error Goto NO_TITLE_FILE
Open titlesFilePath For Input As #tf
lf = FreeFile
On Error Goto NO_LINKS_FILE
Open linksFilePath For Input As #lf
On Error Goto 0
While Not (EOF(tf) Or EOF(lf))
Dim curTitle As String, curLink As String
Line Input #tf, curTitle
Line Input #lf, curLink
Cells(rowStart, 1).Formula = "=HYPERLINK(""" & curLink & """,""" & curTitle & """)"
Wend
Close #tf
Close #lf
Exit Sub
NO_TITLE_FILE:
MsgBox "Can't Open Title File" & titlesFilePath
Exit Sub
NO_LINKS_FILE:
MsgBox "Can't Open Links File" & linksFilePath
End Sub