I need to create a macro (which I have never done before) and if you guys can guide me to a right path, it would be really appreciated.
What I'm doing currently:
I have created a mapping XML which I have imported into Excel. Once it is imported into Excel, users will then go ahead and paste some data in it and export it to receive an XML data file, which then user can drop it to a FTP where the job picks it up and imports it into database.
Here's the problem:
The export has following node, which I do not want:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Root xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
Instead I want to replace it with following:
<?xml version="1.0" ?>
<Root xmlns="http://tempuri.org/CourseImport.xsd">
How do I automate this? Is there some kind of setting in Excel that could make it happen?
Basically, I want the export to have my root instead of the default root and I want to automatically be able to drop the file to specified path: example: \development\school\course import
Thanks!
My co-worker actually helped me out with this. I thought I should share what I did
Sub ExportXML()
'
' Export XML Macro exports the data that is in Excel to XML.
'
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
'
newFileName = Application.GetSaveAsFilename("out.xml", "XML Files (*.xml), *.xmls")
If newFileName = False Then
Exit Sub
End If
If objFSO.FileExists(newFileName) Then
objFSO.DeleteFile (newFileName)
End If
ActiveWorkbook.XmlMaps("Root_Map").Export URL:=newFileName
Set objFile = objFSO.OpenTextFile(newFileName, ForReading)
Dim count
count = 0
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If count = 0 Then
strNewContents = strNewContents & "<?xml version=""1.0"" ?>" & vbCrLf
ElseIf count = 1 Then
strNewContents = strNewContents & "<Root xmlns=""http://tempuri.org/import.xsd"">" & vbCrLf
Else
strNewContents = strNewContents & strLine & vbCrLf
End If
count = count + 1
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile(newFileName, ForWriting)
objFile.Write strNewContents
objFile.Close
End Sub
Related
Using 2010 Excel VBA - I need to use look up the image/pdf with the Branch Code as a part of its name at "C:\ECB Test\ECB IR COPY" and paste it at "C:\ECB Test\" RO if it exists. If it doesn't, the program needs to highlight the Branch Code.
(File Name Examples: 28-Kochi-ecb-sdwan completed.pdf, 23 eCB Kozhikode completed.pdf/0036.jpeg)
Having done this manually twice for two other excel sheets (4k+ cells), I decided to Frankenstein a module together and, well, it does not work and I have no idea why.
Sub Sort()
Const SRC_PATH As String = "C:\ECB Test\ECB IR COPY"
Const DEST_PATH As String = "C:\ECB Test"
Dim Row_Number As Integer
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Dim Folder_Name As String
Dim Branch_Code As String
Dim Final_Path As Variant
Dim File As String
For Row_Number = 3 To 2465
Branch_Code = Worksheets("WAN RFP").Cells(Row_Number, 2)
Folder_Name = Worksheets("WAN RFP").Cells(Row_Number, 5)
On Error Resume Next
File = Dir(SRC_PATH & "\*" & Branch_Code & "*")
Final_Path = Dir(DEST_PATH & "\" & Folder_Name & "\")
If (Len(File) > 0) Then
Call fso.CopyFile(File, Final_Path)
Else
Cells(Row_Number, 2).Interior.ColorIndex = 6
End If
On Error GoTo 0
DoEvents
Next Row_Number
End Sub
I think its unable to use the Branch Code variable as a wildcard, though I might as well have done something silly somewhere in the code. Can someone please help me out?
The problem is you are using the destination path instead of the source path:
File = Dir(DEST_PATH & "*" & Branch_Code & "*.*")
Change it to
File = Dir(SRC_PATH & "*" & Branch_Code & "*.*")
OK, so I have code that will take the data entered in "A3" and open a widows search with "*" + A3's contents. What I need now is when any file is found with that search to find the folder name that houses it. Basically we have prints stored by a random number not associated to the real part number but all the related prints are stored within this random numbered folder.
Example:
C:\Document Control\Master Prints*12345*\printxyz.pdf
If I were to search for "*xyz" and "printxyz.pdf" shows up, I now need the "12345" folder name to populate in a cell.
Here is what im using so far
Sub Macro4()
Dim var As Variant
var = "*" & Range("A3").Value
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=" & var & "&crumb=location:""C:\Document Control\Master Prints" & Chr(34), vbNormalFocus)
End Sub
I did something similar recently. I had words in cell E1 that pertains to files in a folder. So I did an instr on the first 5 letters of that cell as my search then looped through the folder to find the file containing that string.
You should be able to adapt this code to what you need.
Const parentFolder As String = "I:\this\that\"
subFolder = parentFolder & getFoldPath(parentFolder, Left(.Range("E1"), 5)) & "\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(subFolder)
For Each oFile In oFolder.Files
If InStr(oFile, Left(.Range("E1"), 5)) > 0 Then
scope = subFolder & oFile.name
End If
Next
I have a code that succesfully retrieves the node values from XML files but I now have a file where it doesn`t work anymore, eventhough it is the same build up. Is it possible that it has something to do with the "_" sign in the XML? I already checked if I made a typo.
Snapshot of the XML where is works:
<?xml version="1.0" encoding="utf-8"?>
<!-- Automatically generated XML file -->
<ADEL:Report xmlns:ADEL="http://XMLSchema/MT/Generic/ADEL/v2.1.11">
<Header>
<Title>Lot Report</Title>
<MachineID>7</MachineID>
<MachineCustomerName>AT</MachineCustomerName>
<MachineType>X</MachineType>
<SoftwareRelease>at5.0.0.c</SoftwareRelease>
<CreatedBy></CreatedBy>
<CreateTime>2020-03-03T11:32:27.726447+01:00</CreateTime>
<MachineHostDeltaTime>0</MachineHostDeltaTime>
<Comment>
<elt></elt>
</Comment>
<DocumentId>20303-47</DocumentId>
<DocumentType>ADEL</DocumentType>
<DocumentTypeVersion>v2.1.11</DocumentTypeVersion>
<CategoryList></CategoryList>
</Header>
</ADEL:Report>
Snapshot of the XML file where it doesn`t work:
<?xml version="1.0" encoding="UTF-8"?>
<!-- Automatically generated XML file -->
<ADEL:Definitions xmlns:ADEL="http://XMLSchema/MT/TWIN/ADEL/v6.2.1"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://XMLSchema/MT/TWIN/ADEL/v6.2.1 ADEL.xsd">
<RecipeCollection>
<UnitRecipe>
<RecipeStep>
<RECIPE>
<RECIPE_DATA>
<RECIPE_GENERAL_DATA>
<RECIPE_NAME>
<PPID>user_data/RDM/BACKUP</PPID>
</RECIPE_NAME>
<GENERAL_DATA>
<CREATED_BY></CREATED_BY>
<CREATED_TIME>2020-05-16T16:13:49.879847+02:00</CREATED_TIME>
<LAST_MODIFIED_BY></LAST_MODIFIED_BY>
<LAST_MODIFIED_TIME>2020-08-12T09:16:07.409547+02:00</LAST_MODIFIED_TIME>
<STORAGE_MODIFICATION_NR>8</STORAGE_MODIFICATION_NR>
<COMMENT_ARRAY>
<elt><This Formatted Process Program was created from an exported recipe.>
</elt>
</COMMENT_ARRAY>
</GENERAL_DATA>
<SOFTREV>6.2.0.b</SOFTREV>
<LAST_EXPORTED_BY></LAST_EXPORTED_BY>
<LAST_EXPORTED_TIME>2020-08-12T09:16:07.409547+02:00</LAST_EXPORTED_TIME>
<EXPORTED_FROM_STORAGE>8</EXPORTED_FROM_STORAGE>
<EXPORT_MODIFICATION_NR>8</EXPORT_MODIFICATION_NR>
<CALIBRATION_STATE_ID>DEFAULT</CALIBRATION_STATE_ID>
</RECIPE_GENERAL_DATA>
</RECIPE_DATA>
</RECIPE>
</RecipeStep>
</UnitRecipe>
</RecipeCollection>
</ADEL:Definitions>
Code used:
Dim wb As Workbook
Dim FilePath As String
Set wb = ThisWorkbook
FilePath = Application.ActiveWorkbook.Path
MaskId = wb.Sheets("Sheet1").Range("E1").Value
Set oXMLFile = CreateObject("Microsoft.XMLDOM")
XMLFileName = Dir(FilePath & "\" & MaskId & "*.xml")
If XMLFileName = "" Then
MsgBox "no file found"
Else
End If
Debug.Print XMLFileName = ""
oXMLFile.Load (XMLFileName)
MsgBox oXMLFile.validateOnParse
Set MaskNodes = oXMLFile.SelectNodes("/ADEL:Definitions/RecipeCollection/UnitRecipe/RecipeStep/RECIPE/RECIPE_DATA/RECIPE_GENERAL_DATA/SOFTREV/text()")
'Below is working for the other XML file
'Set MaskNodes = oXMLFile.SelectNodes("/ADEL:Report/Input/LotSettings/LotType/text()")
MsgBox MaskNodes(i).NodeValue
I am trying to create a linked table in Access to my Excel spreadsheet that includes hyperlinks. After going through the wizard, my table does not have hyperlinks anywhere. The field type is automatically set to Short Text.
Does anyone know of a fix or a workaround?
I think your terminology is a little messed up, but I'm guessing you are referring to this concept, right.
Option Compare Database
Option Explicit
Private Sub Command0_Click()
'Macro Loops through the specified directory (strPath)
'and links ALL Excel files as linked tables in the Access
'Database.
Const strPath As String = "C:\your_path_here\" 'Directory Path
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list
strFile = Dir(strPath & "*.csv")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files & link to Access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acLinkDelim, , _
strFileList(intFile), strPath & strFileList(intFile), True, ""
'Check out the TransferSpreadsheet options in the Access
'Visual Basic Help file for a full description & list of
'optional settings
Next
MsgBox UBound(strFileList) & " Files were Linked"
End Sub
It is probably better to practice with CSV files, which are easier to work with, compared to Excel files. To loop through Excel files in a folder, and link to each, just change one line of code.
DoCmd.TransferSpreadsheet acLink, , "Your table name","Path to your workbook file", True, "Sheet1!Ran
I have code to delete all files in a folder:
ChDir "C:\test\" 'path
Kill "C:\test*.*" 'type
However, when I open a doc file and save it as a text, it creates a temporary file named ~$*****.doc and these files do not get deleted.
How would I do this?
Sub BatchConvertCSV()
'declarations
Dim i As Integer
Dim j As Integer
Dim NewName As String
Dim objWord As Object
Dim ApplicationFileSearch As New FileSearch
Dim iCnt As Integer
Set objWord = CreateObject("Word.Application")
'search for all.doc files in specified folder
With ApplicationFileSearch
.NewSearch
.LookIn = "C:\test\"
.SearchSubFolders = False
.FileName = "*.doc"
.Execute
j = .FoundFiles.Count
i = 1
MsgBox ("Found files " & j)
'open each document
Do While i < j
Set objWord = Documents.Open(FileName:=.FoundFiles(i))
With ActiveDocument
iCnt = ActiveDocument.Fields.Count
'Somewhere here we need to decide on the placement for an if statement to filter out the doc files for 35 and 39 fields.
'If the doc file does not have that amount of fields
'MsgBox ("Found fields " & iCnt)
If iCnt > 30 And iCnt < 40 Then
.SaveFormsData = True
'save open file as just form data csv file and call it the the vaule of i.txt (i.e 1.txt, 2.txt,...i.txt) and close open file
NewName = i
ChangeFileOpenDirectory "C:\test\Raw Data\"
ActiveDocument.SaveAs FileName:=NewName
objWord.Close False
Else
End If
End With
i = i + 1
Loop
'repeat to the ith .doc file
End With
ChDir "C:\test\" 'path
Kill "C:\test\*.*" 'type
Try this:
With CreateObject("Scripting.FileSystemObject").getfolder("C:\Test")
For Each file In .Files
If Left(file.Name, 2) = "~$" Then
Kill "C:\Test\" & file.Name
End If
Next file
End With
You can, of course, refine that filter as you see fit.
The only problem I can see with that is that you're removing files from .Files while you're looping through them; it might work, but it's probably safer to add each file to a list instead of killing it in the ForEach loop, and then go through and kill everything in the list afterwards.
EDIT:
A little more research. According to this article, you can't use Kill on read-only files. This means you need to use the SetAttr command to remove the "read-only" flag. Here's some code that might help:
Dim strDir, strFile As String
strDir = "C:\Test\" 'Don't forget the trailing backslash
strFile = Dir(strDir & "~$*", vbHidden)
Do Until strFile = ""
If Len(Dir$(strDir & strFile)) > 0 Then
SetAttr strDir & strFile, vbNormal
Kill strDir & strFile
End If
strFile = Dir()
Loop
As you can see, that includes a check that the file actually exists before trying to delete it; as we're pulling that file up with Dir the check shouldn't be necessary, but your experience suggests that extra precautions are needed here. Let me know how that works.