My first post so be kind! I'm trying to import multiple xml files using a schema but using a cell reference as part of the file name. The cell reference is a staff number so this is only to import xml files with that user's ID in the filename.
However, its only importing one file into my schema table instead multiples.
Sub ImportMyFiles()
Dim strFile As String, strPath As String, Num As Long, LR As Integer, UsrID As String
UsrID = Sheets("All_Fields").Range("A2")
strPath = "C:\QuAD_Output\"
strFile = Dir(strPath & UsrID & "*.xml")
Num = 0
While strFile <> ""
ActiveWorkbook.XmlMaps("QuAD_Schema_Map1").Import URL:= _
(strPath & strFile)
strFile = Dir
Num = Num + 1
LR = Cells(Rows.Count, "A").End(xlUp).Row
LR = LR + 1
Cells(LR, "A") = strFile
Wend
MsgBox "This code ran successfully for " & Num & " XML file(s)", vbInformation
End Sub`
See above, managed to resolve the issues with the table properties. Hope this helps someone else
Related
I need to load information from another book into an empty book and link this information to another book using VLookup
I managed to pull the information out of the book, but now how can I link it to another book? I don't understand how to address it, just by opening it? And how best to organize the mapping using For... to ? The current code refers only to the first source workbook.
Sub Curse()
Dim sPath As String, sFile_1 As String, sFile1_2 As String, sheet As String, x As Integer
sSheet = "Sheet1"
sFile_1 = "Form.xlsx"
sFile1_2 = "Date1.xlsx"
sPath = InputBox("Enter the path where the files were saved")
If sPath Like "*\" Then
Else
sPath = sPath & "\"
End If
With Range("A2:B22")
.Formula = "='" & sPath & "[" & sFile_1 & "]" & sSheet & "'!" & "A2"
.Value = .Value
End With
For i = 2 To 22 Step 1
Cells(i, 3) = WorksheetFunction.VLookup(Cells(i, 1), Range("A1:C33"), 3)
Next
End Sub
firstly sorry if my english is not perfect as i'm french.
i'm new to this and i'm trying to make something work for my company to save some time.
i'd like to make a VBA code that Create a Folder with 9 sub folder inside but the tricky part i guess is that inside those 9 sub folders i need to have again sub folders.
i then need to auto copy an excel file to the main folder that have the same name
The Main folder name need to be based after 3 Excel row "A2" "C2" "B2"
Below a screenshot of inside the Main Folder :
I have some code that i found on the web that does some stuff that i need but i don't know how to do it.
Below code that i have :
Sub CreateDirs()
Dim r As Range
Dim RootFolder As String
RootFolder = Range("K2").Value
Range("A2").Select
For Each r In Range(Selection, Selection.End(xlDown))
If Len(r.Text) > 0 Then
On Error Resume Next
MkDir RootFolder & "\" & r.Text
MkDir RootFolder & "\" & r.Text & "\" & Range("L2").Value
MkDir RootFolder & "\" & r.Text & "\" & Range("L3").Value
MkDir RootFolder & "\" & r.Text & "\" & Range("L4").Value
On Error GoTo 0
End If
Next r
End Sub
combined with this code :
Sub File_Transfer()
'
Dim src As String, dst As String, fl As String
Dim lr As Long
'Source directory
'Range("A2").Select
lr = Cells(Rows.Count, "H").End(xlUp).Row
For X = 2 To lr
src = Range("F" & X).Value
'Destination directory
dst = Range("G" & X).Value
'Filename
fl = Range("E" & X).Value
On Error Resume Next
'get project id
FileCopy src & "\" & fl, dst & "\" & fl
If Err.Number <> 0 Then
End If
Next X
On Error GoTo 0
End Sub
Those 2 code will Create Folders with sub folders and will copy an excel file in the main folder but the Main folder is based only on one column
with this code i have this Excel Sheet :
I have this third code that will only create a Main Folder but with my name based on my 3 Column :
Sub ExampleCode()
Dim strName As String
Dim strCode As String
Dim strCode1 As String
Dim fName As String
Dim fPath As String
Dim lastRow As Long
Dim i As Long
Dim ws As Worksheet
'Where will we create these folders?
fPath = "C:\Users\WBRICET\Documents\TESTVBA"
'Error check
If Right(fPath, 1) <> Application.PathSeparator Then
fPath = fPath & Application.PathSeparator
End If
'What sheet has the data?
Set ws = ActiveSheet
Application.ScreenUpdating = False
With ws
'How much data do we have
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop from row 3 to end
For i = 3 To lastRow
'Get the bits
strName = .Cells(i, "A").Value
strCode = .Cells(i, "C").Value
strCode1 = .Cells(i, "B").Value
'Build folder name
fName = strName & " " & strCode & " " & strCode1
'Check if folder already exists
If Dir(fPath & fName, vbDirectory) = "" Then
'Create folder
MkDir fPath & fName
End If
Next i
End With
Application.ScreenUpdating = True
'Since nothing changed on sheet, provide feedback to user
MsgBox "Done!"
End Sub
Sorry for my long post but that would help me a lot in my work and my coworker too.
Thanks again :)
EDIT : if it's easier for the subfolders part could we not do something that copy existing exemple empty folders to the new one created ?
Like The VBA will Create a Folder based on 3 Column "XXX XXX XXX" copy the excel in main folder and also copy empty entire Subfolder "shell" that i normaly copy by hand"
I made a post Copying cells from multiple files in one folder.
This answer was correct however I need to change it.
The code from this:
Sub Macro()
Dim StrFile As String, TargetWb As Workbook, ws As Worksheet, i As Long, StrFormula As String
Const strPath As String = "\\pco.X.com\Y\OPERATIONS\X\SharedDocuments\Regulatory\Z\X\" 'take care of the ending backslash
Set TargetWb = Workbooks("X.xlsm")
Set ws = TargetWb.Sheets("Macro")
i = 3
StrFile = Dir(strPath & "*.xls*") 'it returns all files having extensions as xls, xlsx, xlsm, xlsa, xlsb
Dim sheetName As String: sheetName = "S"
Do While Len(StrFile) > 0
StrFormula = "'" & strPath & "[" & StrFile & "]" & sheetName
ws.Range("B" & i).Value = Application.ExecuteExcel4Macro(StrFormula & "'!R24C3")
ws.Range("A" & i).Value = Application.ExecuteExcel4Macro(StrFormula & "'!R3C2")
i = i + 1
StrFile = Dir() 'needed to continue the iteration up to the last file
Loop
End Sub
In the folder where I pull the two data points from there are over 1000 workbooks. I only need the data from around 20/30 of these.
I was planning on getting all the data from this folder and then doing a quick play around to get to the stuff I need. The macro to pull from these 1000 docs is causing Excel to crash.
Is it possible to only pull the data from these files if part of the file name matches with a list of codes in the master sheet?
For example, in column B there are 20 codes listed "3333", "44444" , "562872" etc. and the only files I want are "ABCD 3333 BDBD", "AJKP 4444" and "hhhhh 562872 ha".
Using the function InStr() and an array could do the trick:
Sub Macro()
Dim StrFile As String, TargetWb As Workbook, ws As Worksheet, i As Long, StrFormula As String
Const strPath As String = "\\pco.X.com\Y\OPERATIONS\X\SharedDocuments\Regulatory\Z\X\" 'take care of the ending backslash
'this is the range where the filename codes are. Change as needed
Dim arr_files As Variant: arr_files = ThisWorkbook.Sheets("Master").Range("B2:B20")
Set TargetWb = Workbooks("X.xlsm")
Set ws = TargetWb.Sheets("Macro")
i = 3
StrFile = Dir(strPath & "*.xls*") 'it returns all files having extensions as xls, xlsx, xlsm, xlsa, xlsb
Dim sheetName As String: sheetName = "S"
Do While Len(StrFile) > 0
If Not file_to_process(StrFile, arr_files) Then GoTo skip_file
StrFormula = "'" & strPath & "[" & StrFile & "]" & sheetName
ws.Range("B" & i).Value = Application.ExecuteExcel4Macro(StrFormula & "'!R24C3")
ws.Range("A" & i).Value = Application.ExecuteExcel4Macro(StrFormula & "'!R3C2")
i = i + 1
skip_file:
StrFile = Dir() 'needed to continue the iteration up to the last file
Loop
End Sub
Private Function file_to_process(file_name As String, arr_files As Variant) As Boolean
Dim Key As Variant
For Each Key In arr_files
If InStr(1, file_name, Key, vbTextCompare) > 0 Then
file_to_process = True
Exit For
End If
Next Key
End Function
I've created a little function to check every filename for every code in the arr_files so if one filename has a code in the string, will check as true and get the data.
I have created a script that splits a large Excel database into 30 rows, creates a new workbook for it.
and checks if there is a folder based on cell value if not then it creates it.
after all of that I want to save my files in that same new folder he created/checked for.
but for some reason after creating a string named path and populating it with the location.
I am receiving an EXPECTED ARRAY error when stating that I want to save it in the path value location.
Public Sub Split_30()
Dim inputFile As String, inputWb As Workbook
Dim lastRow As Long, row As Long, n As Long
Dim newCSV As Workbook
Dim FileN As String
Dim path As String
FileN = Range("O2").Value
path = "C:\OrderCargo\" & Range("O2").Value
Application.ScreenUpdating = False
inputFile = "C:\OrderCargo\Original\ãåç øëù î÷åøé" 'CHANGE TO YOUR INPUT FILE, OR USE GETOPENFILENAME
Set inputWb = Workbooks.Open(inputFile)
With inputWb.Worksheets(1)
lastRow = .Cells(Rows.Count, "A").End(xlUp).row
Set newCSV = Workbooks.Add
n = 0
For row = 1 To lastRow Step 30
n = n + 1
.Rows(row & ":" & row + 30 - 1).EntireRow.Copy newCSV.Worksheets(1).Range("A1")
If Dir(path, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & path & """")
End If
**newCSV.SaveAs FileName:=path**(inputWb.FullName, ".xlsx", " " & Format(Date, "mmm") & " " & FileN & "(" & n & ").csv"), FileFormat:=xlCSV, CreateBackup:=False
Next
End With
newCSV.Close saveChanges:=False
inputWb.Close saveChanges:=False
End Sub
Can anyone please try and help me find the error..
I think you have a race condition. The shell execution "mkdir" might not be finished before trying to save. Try the VBA command mkdir instead.
Today I have a problem of trying to write a csv file line by line with one of the columns formatted as a native excel date. My script works but doesn't export the date correctly and is being exported as as serial string. I simply want the exported file to write the date in the "mm/dd/yyyy" format. Any ideas?
Sub OUTPUT_COMMA_DELIMITED_RANGE()
Dim outputPath As String
Dim outputFileName As String
Dim rSrc As Range
Dim rSrcRow As Range
Dim fso As FileSystemObject
Dim fOut As TextStream
On Error GoTo SomethingBadHappened
Dim MyPathFull As String
outputPath = "C:\workspace\Appendix_Working_Area\Script_Out\"
outputFileName = "Z225R" & Chr(95) & "Eddy_Fluctuating_Zone.csv"
MyPathFull = outputPath & outputFileName
Set fso = CreateObject("scripting.filesystemobject")
Set fOut = fso.CreateTextFile(outputPath & outputFileName)
Dim EddyHghEleZoneRng As Range
Set EddyHghEleZoneRng = Worksheets("225R").Range(Cells(1, 9), Cells(1, 9).End(xlToRight).End(xlDown))
Set rSrc = EddyHghEleZoneRng
For Each rSrcRow In rSrc.Rows
fOut.WriteLine Join(Application.WorksheetFunction.Transpose _
(Application.WorksheetFunction.Transpose(rSrcRow)), ",")
Next rSrcRow
MsgBox "File " & outputPath & outputFileName & " created successfully"
SomethingBadHappened:
If Err.Number <> 0 Then MsgBox Err.Description
On Error Resume Next
fOut.Close
If Err.Number <> 0 And Err.Number <> 91 Then MsgBox "Unable to close file (" & Err.Description & ")"
End Sub
I have chosen to manually create the csv file because id don't want any of the unwanted characters associated with using the FileFormat:=xlCSV feature built in to excel.
To provide a sample of the kind of data i am dealing i have created an example of what i want the output csv file too look like.
Site,Date,Plane_Height,Area_2D,Area_3D,Volume,Errors
225r,11/3/1990,8kto25k,2212.834,2235.460,841.76655,88.513
Thanks,
dubbbdan
It appears that your data is contained in 6 columns. Here is a way to make a .csv which preserves date formats:
Sub MakeCSVFile()
Dim N As Long, M As Long, i As Long, j As Long
Dim OutRec As String
N = Cells(Rows.Count, "A").End(xlUp).Row
M = 6
Close #1
Open "C:\TestFolder\x.csv" For Output As #1
For i = 1 To N
OutRec = Cells(i, 1).Text
For j = 2 To M
OutRec = OutRec & "," & Cells(i, j).Text
Next j
Print #1, OutRec
Next i
Close #1
End Sub